{**************************************************************************************************}
{                                                                                                  }
{ Delphi language Preprocessor (dpp32)                                                             }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is dpp_Macros.pas                                                              }
{                                                                                                  }
{ The Initial Developer of the Original Code is Andreas Hausladen                                  }
{ Portions created by these individuals are Copyright (C) of these individuals.                    }
{                                                                                                  }
{ You may retrieve the latest version of this file at the Projects home page, located at           }
{ http://www.sourceforge.net/projects/dpp32                                                        }
{                                                                                                  }
{**************************************************************************************************}
unit dpp_Macros;
(*******************************************************************************
* Preprocessor for Delphi and Kylix compiler (dcc32, dcc)
* =======================================================
*
* This preprocessor make it possible for Delphi developers to use the power of
* macros in Object Pascal code. The macros acts like the C/C++ preprocessor
* macros with the exception of conditional compilation.
*
*
* Macro Syntax:
* {$define macroname}          // registers a macro
* {$undef macroname}           // unregisters a the macro
* {MACROINCLUDE mymacros.mac}  // does only include the macros from the file
*
* Examples:
* {$define macroname1   replacement text }
* {$define macroname2(arg1, arg2) WriteLn(#arg1); ReadLn(arg2 ## _Var) }
* {$undef macroname2}
*
*
*
* The macros in the interface sections of the USES units are not imported. For
* macro imports use MACROINCLUDE.
*
* For every unit in the uses-statement a MACROINCLUDE is automatically generated
* e.g. uses MyUnit; -> MyUnit.macros is included if it exists. For the current
* unit also the corresponding .macros file is also included. The .macros file
* must exist in the same directory as the unit itself and it cannot contain any
* source code. Only macro declarations ($define, $undef, MACROINCLUDE) are
* allowed. Other code is ignored.
*
* The preprocessor follows the compiler directive {$I filename} and
* {$INCLUDE filename}. For every included file a copy of the preprocessed files
* is generated to support differences in macro defined before the include
* directive.
*
*
* ISSUES:
*   - The compiler has a line limit of 1024 chars. For larger macros a unique
*     include file can be necessary. Splitting the macro in more lines will
*     break the error message lines. Prehaps the preprocessor can modify the
*     original file by inserting "{MACROPLACE}" comment lines after the long
*     line.
*
*   - No conditional expressions (Delphi 6+) are supported by the preprocessor.
*     All macros in such an expression are parsed and replaced. In order to
*     support this feature an expression parser is necessary. Furthermore
*     we must collect all *const* expressions. But how can we get the consts
*     from a compiled unit (.dcu).
*
*******************************************************************************)
{.$define HASHTABLE}
interface

uses
  Types, SysUtils, Classes, Contnrs, dpp_PascalParser, dpp_Utils;

const
  MaxFileRecursion = 30; // files can be opened at once

type
  TWarningEvent = procedure(Sender: TObject; const Filename, Msg: string;
    LineNum: Integer) of object;
  TErrorEvent = procedure(Sender: TObject; const Filename, Msg: string;
    LineNum: Integer) of object;
  TPredefineMacrosEvent = procedure(Sender: TObject) of object;
  TDefaultConditionalsEvent = procedure(Sender: TObject) of object;
  TBuiltInMacroEvent = function(Sender: TObject; Token: PTokenInfo;
    var Replacement: string; var IsBuiltIn: Boolean): string of object;

  TMacroCompare = function(const S1, S2: string): Integer;

  TParseType = (
    ptUnit,            // collect and replace macros in the whole file
    ptInclude,         // collect and replace macros in the whole file but use some special file handling
    ptInterfaceMacros  // collect macros from the interface-section of the file (only for MACROINCLUDE)
  );

 { TPascalParserEx make it easier to pass NoReplaceMacros across the
   TMacro.methods. }
  TPascalParserEx = class(TPascalParser)
  public
    NoReplaceMacros: Boolean;
  end;

  TMacros = class;
  TMacroList = class;

  IMacroFileSys = interface
  ['{F3CD3F56-F849-4C9E-BD57-3D76DE6E0C64}']
    { Called before the file is read. The file exists. }
    procedure BeforeFile(const FileName: string; IsIncludeFile: Boolean);
    { Called after the file was stored depending on Modified. Filename is a
      full qualified file name. The file and the new file exist. }
    procedure AfterFile(const FileName, NewFileName: string; IsIncludeFile,
      Modified: Boolean);
    { LoadFile must return the file content in *Content*. Filename is a
      full qualified file name. The file exists. }
    procedure LoadFile(const Filename: string; out Content: string;
      IsIncludeFile: Boolean);
    { SaveFile is called for saving the file's content. Filename is the original
      filename and NewFilename is the preprocessor's new file name. All file
      names are full qualified file names. The file exists but the new file
      doesn't. }
    procedure SaveFile(const Filename: string; var NewFilename: string;
      const Content: string; IsIncludeFile: Boolean);
    { FindFile is called if the file name is not a full qualified file
      name. Return the full qualified file name or '' if the file does not
      exist. }
    function FindFile(const Filename: string; IsIncludeFile: Boolean): string;
    { FileExists must return True if the given File exists. Filename is a
      full qualified file name. }
    function FileExists(const Filename: string): Boolean;

    { LinesMoved is called for macro replacements using more than one line.
      LineNum   : line where the macro is.
      AddedLines: number of inserted lines }
    procedure LinesMoved(const Filename: string; LineNum, AddedLines: Integer);
  end;

  TMacroItem = class(TObject)
  private
    FMacroList: TMacroList;
    FName: string;
    FReplacement: string;
    FHasBrackets: Boolean;
    FArguments: TStringDynArray;
    FInterfaceMacro: Boolean; // if TRUE the $ifdef/$ifndef must be modified
  public
    constructor Create(AMacroList: TMacroList);
    function Parse(const MacroNameArgReplacement: string; out ErrorMsg: string;
      AInterfaceMacro: Boolean): Boolean;
    function IsEqual(Item: TMacroItem): Boolean;
    procedure Assign(Item: TMacroItem);
    function IndexOfArg(const ArgName: string): Integer;

    property Name: string read FName;
    property Replacement: string read FReplacement;
    property HasBrackets: Boolean read FHasBrackets write FHasBrackets;
    property Arguments: TStringDynArray read FArguments;
    property MacroList: TMacroList read FMacroList;
    property InterfaceMacro: Boolean read FInterfaceMacro write FInterfaceMacro;
  end;

  TMacroList = class(TObjectList)
  private
    FMacros: TMacros;
    FHashTable: TRedirectTable;
    function GetItems(Index: Integer): TMacroItem;
  protected
    function IndexOfMacro(const Name: string): Integer;
  public
    constructor Create(Macros: TMacros);
    procedure Assign(MacroList: TMacroList);
    procedure Clear; override;

    function RegisterMacro(const Macro: string; AInterfaceMacro: Boolean): TMacroItem;  // in: 'test(x) x*x' // DEVINFO: Macro must be TrimLeft()
    procedure UnregisterMacro(const Name: string);            // in: 'test'        // DEVINFO: Macro must be Trim()
    function IsMacroRegistered(const Name: string): Boolean;                       // DEVINFO: Macro must be Trim()

    function FindMacro(const Name: string): TMacroItem;

    property Items[Index: Integer]: TMacroItem read GetItems;
  end;

  TMacros = class(TMacroList)
  private
    FCaseSensitive: Boolean;
    FConditionalParse: Boolean;
    FErrorMsg: string;

    FUnits: TStrings;        // contains all units (interface and implementation <uses>); "MacroFileExists:=Boolean(Objects[])"
    FIncludeFiles: TStrings; // contains all include files. Integer(Objects[]): how often the file is used

    FMacroMacroRecursion: TList; // used for in macro replacement see TMacros.ReplaceMacro()
    FFileRecursion: Integer;  // number of open include files

    FConditionals: TStrings; // $define, $ifdef, $ifndef - conditional compilation
    FCompilerOptions: TStrings; // $ifopt - conditional compilation
    FConditionalParseCode: TBooleanList; // .LastItem=True: parse code; .LastItem=False: ignore code and macros

    FAppType: string;
    FFileSys: IMacroFileSys;

    FCompare: TMacroCompare;
    FOnError: TErrorEvent;
    FOnWarning: TWarningEvent;
    FOnPredefineMacros: TPredefineMacrosEvent;
    FOnBuiltInMacro: TBuiltInMacroEvent;
    FOnDefaultConditionals: TDefaultConditionalsEvent;

    procedure SetCaseSensitive(const Value: Boolean);
  protected
    procedure Warning(const Msg, FileName: string; LineNum: Integer); overload;
    procedure Warning(const Msg: string; Token: PTokenInfo); overload;
    procedure Error(const Msg, FileName: string; LineNum: Integer); overload;
    procedure Error(const Msg: string; Token: PTokenInfo); overload;
    procedure PredefineMacros;
    function BuiltInMacro(Token: PTokenInfo; var Replacement: string): Boolean;
    procedure DefaultConditionals;

    function ParseUnitMacroFile(UnitIndex: Integer): Integer;
    function ParseFile(Filename: string; ParseType: TParseType;
      TestFileExistence: Boolean): string; // returns new filename (.i.pas, .i1.*, .i2.*, ...)
    function ParseString(var Text: string; const Filename: string;
      StartLineNum: Integer; ParseType: TParseType): Boolean;

    function NextToken(Parser: TPascalParserEx; out Token: PTokenInfo): Boolean; overload;
    function NextToken(Parser: TPascalParserEx): PTokenInfo; overload;
    function ParseConditionals(var Line: string; const Filename: string;
      StartLineNum: Integer): Boolean;
    function ParseComment(Token: PTokenInfo): Boolean;
    procedure ParseUsesIdent(Parser: TPascalParserEx);

    function GetReplacement(Item: TMacroItem; const Args: TStringDynArray;
      const Filename: string; StartLineNum: Integer): string;
    procedure ReplaceMacro(Parser: TPascalParserEx; Item: TMacroItem);

    function RegisterMacroByToken(const Macro: string; Token: PTokenInfo): TMacroItem;
  public
    constructor Create(AFileSys: IMacroFileSys);
    destructor Destroy; override;

    procedure Define(const Condition: string); // defines a condition (FConditionals)
    procedure Undefine(const Condition: string); // undefines a condition (FConditionals)
    procedure SetOption(const Option: string; Value: Boolean);
    function IsDefined(const Condition: string): Boolean; // return TRUE if the condition is defined (FConditionals)

    function Parse(const FileName: string; OnlyThisFile: Boolean): Boolean;

    property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive default True;
    property ConditionalParse: Boolean read FConditionalParse write FConditionalParse default False;
    property ErrorMsg: string read FErrorMsg;

    property OnWarning: TWarningEvent read FOnWarning write FOnWarning;
    property OnError: TErrorEvent read FOnError write FOnError;
    property OnPredefineMacros: TPredefineMacrosEvent read FOnPredefineMacros write FOnPredefineMacros;
    property OnDefaultConditionals: TDefaultConditionalsEvent read FOnDefaultConditionals write FOnDefaultConditionals;
    property OnBuiltInMacro: TBuiltInMacroEvent read FOnBuiltInMacro write FOnBuiltInMacro;
  end;

implementation

resourcestring
 // error messages
  SMacroArgumentsSyntaxError = 'No valid macro name/argument: %s';
  SMacroNotEnoughArguments = 'Not enough arguments for %s';
  SMacroSytaxError = 'Syntax error: %s';
  SEmptyMacroArgument = 'Macro argument is empty.';
  SNoFurtherToken = 'Unexpected file/macro end.';
  SCanOnlyMakeStringFromArguments = 'Can only use # on macro arguments.';
  SCombineError = 'Wrong usage for ##.';
  SNoArgumentSpecified = 'No argument specified for macro.';
  SMacroRedefinitionNotIdentical = 'Redeclaration of "%s" is not identical.';
  SToManyRecursions = 'To many file recursions.';
  SFindFile = 'File "%s" not found.';
  SConditionalSyntaxError = 'Syntax error in conditional directive.';

const
  SMacroStartString = '$DEFINE ';
  SUnmacroStartString = '$UNDEF ';
  SMacroIncludeString = 'MACROINCLUDE ';
  SMacroIncludeFileExt = '.macros';

  SBuiltInStartChars = '__'; // do not modify or localize 
  SBuiltIn_Line = '__LINE__';
  SBuiltIn_File = '__FILE__';
  SBuiltIn_Date = '__DATE__';
  SBuiltIn_Time = '__TIME__';

{ TMacroItem }

constructor TMacroItem.Create(AMacroList: TMacroList);
begin
  inherited Create;
  FMacroList := AMacroList;
end;

procedure TMacroItem.Assign(Item: TMacroItem);
var i: Integer;
begin
  FHasBrackets := Item.FHasBrackets;
  SetLength(FArguments, Length(Item.FArguments));
  FReplacement := Item.FReplacement;
  for i := 0 to High(FArguments) do
    FArguments[i] := Item.FArguments[i];
end;

{ IndexOfArg() returns the index of the macro argument with the name ArgName. }
function TMacroItem.IndexOfArg(const ArgName: string): Integer;
var cmp: TMacroCompare;
begin
  cmp := FMacroList.FMacros.FCompare;
  for Result := 0 to High(Arguments) do
    if cmp(ArgName, Arguments[Result]) = 0 then Exit;
  Result := -1;
end;

function TMacroItem.IsEqual(Item: TMacroItem): Boolean;
var
  i: Integer;
  cmp: TMacroCompare;
begin
  Result := False;
  if FHasBrackets <> Item.FHasBrackets then Exit;
  if Length(FArguments) <> Length(Item.FArguments) then Exit;
  if FReplacement <> Item.FReplacement then Exit;

  cmp := FMacroList.FMacros.FCompare;
  for i := 0 to High(FArguments) do
    if cmp(FArguments[i], Item.FArguments[i]) <> 0 then Exit;

  Result := True;
end;

procedure SetTrimString(out S: string; P: PChar; Count: Integer);
var
  F: PChar;
begin
  while {(P[0] <> #0) and }(P[0] <= #32) and (Count > 0) do
  begin
    Inc(P);
    Dec(Count);
  end;
  if Count > 0 then
  begin
    F := P;
    Inc(P, Count);
    while (P > F) and (P[0] <= #32) do Dec(P);
    SetString(S, F, P - F);
  end
  else
    S := '';
end;

{ Parse() parses the macro declaration and split it to its name, arguments and
  replacement. }
function TMacroItem.Parse(const MacroNameArgReplacement: string; out ErrorMsg: string;
  AInterfaceMacro: Boolean): Boolean;
var
  F, P: PChar;
  ArgCount: Integer;
  i: Integer;
begin
  FInterfaceMacro := AInterfaceMacro;
  FHasBrackets := False;

  Result := False;

 // parse Macro name string
  F := Pointer(MacroNameArgReplacement);
  if F = nil then Exit;
  P := F;
  while not (P[0] in [#0, '(', #9, #10, #13, ' ']) do Inc(P);
  SetString(FName, F, P - F);
 // test for valid identifier
  if not IsValidIdent(FName) then
  begin
    ErrorMsg := Format(SMacroArgumentsSyntaxError, [FName]);
    Exit;
  end;

 // parse Macro arguments
  if P[0] = '(' then
  begin
    FHasBrackets := True;

    F := P + 1;
    ArgCount := CountCharsStop(',', ')', F) + 1;
    SetLength(FArguments, ArgCount);

    for i := 0 to ArgCount - 1 do
    begin
      while not (P[0] in [#0, ',', ')']) do Inc(P);
      SetTrimString(FArguments[i], F, P - F);
{      SetString(FArguments[i], F, P - F);
      FArguments[i] := Trim(FArguments[i]); // trim it}
      Inc(P); // next char
      F := P;

     // test for valid identifier
      if not IsValidIdent(FArguments[i]) then
      begin
        ErrorMsg := Format(SMacroArgumentsSyntaxError, [FArguments[i]]);
        Exit;
      end;
    end;

   // only one argument which is empty -> free memory
    if (ArgCount = 1) and (Length(FArguments[0]) = 0) then
      SetLength(FArguments, 0);
    if P[0] = ')' then Inc(P);
  end;

  Result := True;
  
  if P[0] = #0 then Exit;
  while (P[0] <> #0) and (P[0] <= #32) do Inc(P);
  FReplacement := TrimRight(P);
end;

{ TMacroList }

constructor TMacroList.Create(Macros: TMacros);
begin
  inherited Create;
  FMacros := Macros;
end;

procedure TMacroList.Assign(MacroList: TMacroList);
var
  i: Integer;
  Item: TMacroItem;
begin
  Clear;
  for i := 0 to MacroList.Count - 1 do
  begin
    Item := TMacroItem.Create(Self);
    Item.Assign(MacroList.Items[i]);
    Add(Item);
    MakeStringHash(Item.Name, Integer(Item), FHashTable);
  end;
end;

function TMacroList.GetItems(Index: Integer): TMacroItem;
begin
  Result := TMacroItem(inherited Items[Index]);
end;

function TMacroList.IndexOfMacro(const Name: string): Integer;
begin
  for Result := 0 to Count - 1 do
    if FMacros.FCompare(TMacroItem(inherited Items[Result]).Name, Name) = 0 then
      Exit;
  Result := -1;
end;

function TMacroList.FindMacro(const Name: string): TMacroItem;
{$ifndef HASHTABLE}
var
  i: Integer;
  cmp: TMacroCompare;
{$endif}
begin
{$ifdef HASHTABLE}
  Result := TMacroItem(FindStringHash(Name, FHashTable, FMacros.FCaseSensitive));
{$else}
  cmp := FMacros.FCompare;
  for i := 0 to Count - 1 do
  begin
    Result := TMacroItem(inherited Items[i]);
    if cmp(Result.Name, Name) = 0 then Exit;
  end;
  Result := nil;
{$endif}
end;

function TMacroList.IsMacroRegistered(const Name: string): Boolean;
begin
{$ifdef HASHTABLE}
  Result := FindStringHash(Name, FHashTable, FMacros.FCaseSensitive) <> 0;
{$else}
  Result := IndexOfMacro(Name) >= 0;
{$endif}
end;

{ RegisterMacro() registers a new macro. If the macro is already registered and
  the new version is different then the preprocessor warns the user. This
  warning is generated by the caller who test the property ErrorMsg.
  The Macro-string must be left trimmed. }
function TMacroList.RegisterMacro(const Macro: string; AInterfaceMacro: Boolean): TMacroItem;
var Item: TMacroItem;
begin
  FMacros.FErrorMsg := '';

  Result := TMacroItem.Create(Self);
  try
    if not Result.Parse(Macro, FMacros.FErrorMsg, AInterfaceMacro) then
    begin
      Result.Free;
      Result := nil;
      Exit;
    end;

    Item := FindMacro(Result.Name);
    if Item <> nil then
    begin
     // test if it is the same declaration
      if not Result.IsEqual(Item) then
      begin
        FMacros.FErrorMsg := Format(SMacroRedefinitionNotIdentical, [Result.Name]);
{$ifdef HASHTABLE}
        DelStringHash(Integer(Item), FHashTable);
{$endif}
        Remove(Item); // replace macro with the new one
      end;
    end;
{$ifdef HASHTABLE}
    MakeStringHash(Result.Name, Integer(Result), FHashTable);
{$endif}

    Add(Result);
  except
    Result.Free;
    raise;
  end;
end;

procedure TMacroList.UnregisterMacro(const Name: string);
{$ifdef HASHTABLE}
var Item: TMacroItem;
begin
  Item := TMacroItem(FindStringHash(Name, FHashTable, FMacros.FCaseSensitive));
  if Item <> nil then
  begin
    DelStringHash(Integer(Item), FHashTable);
    Delete(IndexOf(Item));
  end;
end;
{$else}
var Index: Integer;
begin
  Index := IndexOfMacro(Name);
  if Index >= 0 then
  begin
    DelStringHash(Integer(Items[Index]), FHashTable);
    Delete(Index);
  end;
end;
{$endif}

procedure TMacroList.Clear;
begin
{$ifdef HASHTABLE}
  SetLength(FHashTable, 0);
{$endif}
  inherited Clear;
end;

{ TMacros }

constructor TMacros.Create(AFileSys: IMacroFileSys);
begin
  inherited Create(Self);
  FUnits := TStringList.Create;
  FIncludeFiles := TStringList.Create;
  FMacroMacroRecursion := TList.Create;
  SetCaseSensitive(True);

  FConditionals := TStringList.Create;
  FCompilerOptions := TStringList.Create;
  FConditionalParseCode := TBooleanList.Create;
  FConditionalParse := False;

  FFileSys := AFileSys;
end;

destructor TMacros.Destroy;
begin
  FConditionalParseCode.Free;
  FCompilerOptions.Free;
  FConditionals.Free;
  FMacroMacroRecursion.Free;
  FIncludeFiles.Free;
  FUnits.Free;

  FFileSys := nil;
  inherited Destroy;
end;

procedure TMacros.SetCaseSensitive(const Value: Boolean);
begin
  FCaseSensitive := Value;
  if FCaseSensitive then FCompare := CompareStr else FCompare := CompareText;
end;

procedure TMacros.Error(const Msg, FileName: string; LineNum: Integer);
begin
  if Assigned(FOnError) then FOnError(Self, FileName, Msg, LineNum);
  Abort; // raise EAbort Exception -> exit all
end;

procedure TMacros.Error(const Msg: string; Token: PTokenInfo);
var
  Filename: string;
begin
  if Token = nil then
    Error(Msg, '', 0)
  else
  begin
    if Token.pFilename <> nil then
      Filename := Token.pFilename^;
    Error(Msg, FileName, Token.StartLine);
  end;
end;

procedure TMacros.Warning(const Msg, FileName: string; LineNum: Integer);
begin
  if Assigned(FOnError) then FOnWarning(Self, FileName, Msg, LineNum);
end;

procedure TMacros.Warning(const Msg: string; Token: PTokenInfo);
begin
  Warning(Msg, Token.pFileName^, Token.StartLine);
end;

procedure TMacros.PredefineMacros;
begin
  if Assigned(FOnPredefineMacros) then FOnPredefineMacros(Self);
end;

{ RegisterMacroByToken() registers a new macro and triggers error and warning
  messages if necessary. }
function TMacros.RegisterMacroByToken(const Macro: string; Token: PTokenInfo): TMacroItem;
begin
  Result := RegisterMacro(TrimLeft(Macro),
                          TPascalParserEx(Token^.Parser).NoReplaceMacros);  // sets ErrorMsg to '' or error message
  if (ErrorMsg <> '') then
  begin
    if Result = nil then Error(FErrorMsg, Token); // Abort
    Warning(FErrorMsg, Token);
    FErrorMsg := '';
  end;
end;

{ Parse() calls for every unit that it finds the ParseFile() method. }
function TMacros.Parse(const FileName: string; OnlyThisFile: Boolean): Boolean;
var i: Integer;
begin
  Result := True;
  FUnits.Clear;
  FIncludeFiles.Clear;
  FAppType := '';

  FUnits.AddObject(FileName, Pointer(0)); // Even if this file is no unit something has to be parsed
  try
   // parse all used units
    i := 0;
    while i < FUnits.Count do
    begin
      Clear; // clear macro list

      FMacroMacroRecursion.Clear; // reset macro macro recursion
      FFileRecursion := 0;        // reset file recursions

     // reset conditionals
      FConditionals.Clear;
      FConditionalParseCode.Clear; // Count=0 -> .LastItem=True
      DefaultConditionals;

     // get user predefined macros
      PredefineMacros;

     // parse macro include file for this unit
      ParseUnitMacroFile(i);
     // parse this unit
      ParseFile(FUnits[i], ptUnit, {TestFileExistence:=}False);

      Inc(i); // next unit

      if OnlyThisFile then Break; // do not parse other units
    end;
  except
    on EAbort do
      Result := False; // return False
  end;
end;


{ ParseUnitMacroFile() first checks if the macro file exists and then parses
  the file. }
function TMacros.ParseUnitMacroFile(UnitIndex: Integer): Integer;
var MacroFilename: string;
begin
 // Assert(UnitIndex >= 0);
  // Objects[]:
  //   -1: no macros file existance tested
  //    0: no macros file
  //    1: macros file exists
  Result := Integer(FUnits.Objects[UnitIndex]);

  case Result of
    -1:
      begin
        Result := 0;
        MacroFilename := ChangeFileExt(FUnits[UnitIndex], SMacroIncludeFileExt);
        if FFileSys.FileExists(MacroFilename) then
          if ParseFile(MacroFileName, ptInterfaceMacros,
                       {TestFileExistence:=}False) <> '' then
            Result := 1;
        FUnits.Objects[UnitIndex] := Pointer(Result);
      end;
    1:
      begin
        MacroFilename := ChangeFileExt(FUnits[UnitIndex], SMacroIncludeFileExt);
        ParseFile(MacroFileName, ptInterfaceMacros, {TestFileExistence:=}False);
      end;
  end;
end;


{ ParseFile() first checks for the existence of the file and then it calls
  ParseString() with the file content. If the file is an include file (called
  by ParseComments() ) then the file name is added to the FIncFiles list.
  The modified files are saved a .i.pas or .iX.* files (for more information
  see Utils.GetPreProcessedFilename() ). }
function TMacros.ParseFile(Filename: string; ParseType: TParseType;
  TestFileExistence: Boolean): string;
var
  S: string;
  Modified: Boolean;
  Index, IncludeIndex: Integer;
begin
  Result := '';

  Inc(FFileRecursion);
  try
    if FFileRecursion > MaxFileRecursion then // too many open files
      Error(SToManyRecursions, Filename, 1);

   // find the file
    if TestFileExistence then
    begin
      if not FFileSys.FileExists(Filename) then
      begin
        Filename := FFileSys.FindFile(Filename, ParseType = ptInclude); // try to get the file name
        if Length(Filename) = 0 then Exit;
      end;
    end;

    Modified := False;
    Result := Filename;
    if ParseType <> ptInterfaceMacros then
      FFileSys.BeforeFile(Filename, ParseType = ptInclude);
    try
      FFileSys.LoadFile(Filename, S, ParseType = ptInclude);  // load file into a string

      if S <> '' then
      begin
       // parse file and replace macros
        Modified := ParseString(S, Filename, {StartLinenum:=}1, ParseType);

        if ParseType = ptInterfaceMacros then
          Modified := False; // only read these files, do not write these files

        if (Modified) then
        begin
          if ParseType = ptInclude then
          begin
           // change file extension to .i1.*, .i2.* and so on for include files
            Index := IndexOfFilename(FIncludeFiles, Filename);
            if Index = -1 then
            begin
              FIncludeFiles.AddObject(Filename, Pointer(1));
              IncludeIndex := 1;
            end
            else
            begin
              IncludeIndex := Integer(FIncludeFiles.Objects[Index]) + 1;
              FIncludeFiles.Objects[Index] := Pointer(IncludeIndex);
            end;
          end
          else
            IncludeIndex := 0; // -> .i.pas

          Result := GetPreProcessedFilename(Filename, IncludeIndex);
          FFileSys.SaveFile(Filename, Result, S, ParseType = ptInclude); // save string to file
        end;
      end;

    finally
      if ParseType <> ptInterfaceMacros then
        FFileSys.AfterFile(Filename, Result, ParseType = ptInclude, Modified);
    end;
  finally
    Dec(FFileRecursion);
  end;
end;


{ ParseString() is the main parsing method. It is called by ParseComment() and
  ParseFile(). There is no interesting stuff in this function. }
function TMacros.ParseString(var Text: string; const Filename: string;
  StartLineNum: Integer; ParseType: TParseType): Boolean;
var
  Parser: TPascalParserEx;
  Token: PTokenInfo;
begin
  Parser := TPascalParserEx.Create(Filename, Text, StartLineNum);
  try
    Parser.NoReplaceMacros := ParseType = ptInterfaceMacros;
    while NextToken(Parser, Token) do // NextToken() replaces macros
    begin
      if Token.Kind = tkComment then
      begin
       // test for macro related comments
        ParseComment(Token); // FConditionalParseCode is tested in ParseComment()
      end
      else if Token.Kind = tkIdent then
      begin
        if FConditionalParse and not FConditionalParseCode.Last then // still in a "false condition"
          Continue;

        if (ParseType = ptInterfaceMacros) then
        begin
          if (SameText(Token.Value, 'implementation')) then
            Break; // do not parse any implementation macros
        end
        else
        begin
          if (SameText(Token.Value, 'uses')) or (SameText(Token.Value, 'contains')) then
            ParseUsesIdent(Parser); // parse USES statement
        end;
      end;
    end;
  finally
    Result := Parser.Modified;
    if Result then Text := Parser.Text; // replace Text
    Parser.Free;
  end;
end;


{ NextToken() returns the next token. If there is no further token the result
  value is FALSE else TRUE and the Token argument is NIL.
  For every token which is a macro name the ReplaceMacros() method is called. }
function TMacros.NextToken(Parser: TPascalParserEx; out Token: PTokenInfo): Boolean;
var
  Item: TMacroItem;
  Replacement: string;
begin
  if (Parser.NoReplaceMacros) or (FConditionalParse and not FConditionalParseCode.Last) then
  begin
   // just collect macros
    Result := Parser.GetToken(Token);
    Exit;
  end;
 // replace macros
  repeat
    Result := Parser.GetToken(Token);
    if (Result) and (Token.Kind = tkIdent) then
    begin
      if (Token.Value[1] = SBuiltInStartChars[1]) and
         (Token.Value[2] = SBuiltInStartChars[2]) and // may be point to #0 but this is no problem
         (BuiltInMacro(Token, Replacement)) then
      begin
       // built in simple macros
        Parser.ReplaceParseNext(Token, Token, Replacement);
      end
      else
      begin
        Item := FindMacro(Token.Value);
        if (Item <> nil) then
          ReplaceMacro(Parser, Item)
        else
          Break; // no macro -> return token
      end;
    end
    else
      Break; // no macro -> return token
  until False;
end;


{ NextToken(): no comment }
function TMacros.NextToken(Parser: TPascalParserEx): PTokenInfo;
begin
  NextToken(Parser, Result);
end;


{ ParseConditionals() parses all {$... compiler directives. It also interprets
  the $IFDEF, $IFNDEF, $ELSE, $ENDIF and $APPTYPE directives.

  $DEFINE und $UNDEF are directly handled by ParseComment().
}
function TMacros.ParseConditionals(var Line: string; const Filename: string;
  StartLineNum: Integer): Boolean;
type
  TConditionalWordType = (cwNone,
    cwIfdef, cwIfndef, {cwIfopt,} cwElse,
    cwEndif, {cwIf, cwElseif, cwIfend,} cwAppType
  );
const
  ConditionalWords: array[TConditionalWordType] of string = (
    '',
    'ifdef', 'ifndef', {'ifopt',}
    'else', 'endif',
    {'if', 'elseif', 'ifend'}
    'apptype'
  );
  procedure SyntaxError;
  begin
    Error(SConditionalSyntaxError, Filename, StartLineNum);
  end;

var
  Parser: TPascalParserEx;
  Token: PTokenInfo;
  ConditionalWord, Found: TConditionalWordType;
  Item: TMacroItem;
begin
  System.Delete(Line, 1, 1); // remove '$'
  if (Length(Line) = 0) or (Line[1] <= ' ') then SyntaxError;

  Parser := TPascalParserEx.Create(Filename, Line, StartLineNum);
  try
    if (not Parser.GetToken(Token)) or (Token.Kind <> tkIdent) then
      Token.Value := '';

    ConditionalWord := cwNone;
    for Found := Low(TConditionalWordType) to High(TConditionalWordType) do
      if SameText(Token.Value, ConditionalWords[Found]) then
      begin
        ConditionalWord := Found;
        Break;
      end;

    case ConditionalWord of
      cwIfdef, cwIfndef:
        begin
          if not FConditionalParse or FConditionalParseCode.Last then // can parse these line
          begin
            Token := Parser.GetToken;
            if Token = nil then SyntaxError;

            Item := FindMacro(Token.Value);
            case ConditionalWord of
              cwIfdef:
                begin
                  if (Item <> nil) and (Item.InterfaceMacro) then
                  begin
                   // replace the token by 'PREPROCESSOR'
                    FConditionalParseCode.Add(True);
                    Parser.ReplaceParseNext(Token, Token, 'PREPROCESSOR');
                  end
                  else
                    FConditionalParseCode.Add(IsDefined(Token.Value));
                end;

              cwIfndef:
                begin
                  if (Item <> nil) and (Item.InterfaceMacro) then
                  begin
                   // replace the token by 'NEVER_DEFINED'
                    FConditionalParseCode.Add(False);
                    Parser.ReplaceParseNext(Token, Token, 'NEVER_DEFINED');
                  end
                  else
                    FConditionalParseCode.Add(not IsDefined(Token.Value));
                end;
            end;
          end;
        end; // cwDefine, cwUndefine, cwIfdef, cwIfndef
      cwElse: FConditionalParseCode.ToggleLast;
      cwEndif: FConditionalParseCode.DeleteLast;
      cwAppType:
        begin
          if not FConditionalParse or FConditionalParseCode.Last then // can parse these line
          begin
            if (NextToken(Parser, Token)) and (Token.Kind = tkIdent) then
            begin
              FAppType := Token.Value;
              if SameText(FAppType, 'CONSOLE') then Define('CONSOLE')
                                               else Undefine('CONSOLE');
            end;
          end;
        end; // cwAppType

      else
        if not FConditionalParse or FConditionalParseCode.Last then // can parse these line
         // parse and replace macros
          while NextToken(Parser, Token) do ; // replace macros
    end; // case
  finally
    Result := Parser.Modified;
    if Result then Line := '$' + Parser.Text;
    Parser.Free;
  end;
end;


{ ParseComment() parses all comment tokens. Single line comments (//) are
  ignored. It registers all found MACRO statments. For include files $I and
  $INCLUDE the ParseFile() method is called. After parsing the include file
  the $I/$INCLUDE statment is replaced by the new filename returned by
  ParseFile().

  For compiler directives and conditional compilation macros are replaced. }
function TMacros.ParseComment(Token: PTokenInfo): Boolean;
var
  ps, BracketCount, ri, Len: Integer;
  Item: TMacroItem;
  s, Filename: string;
  IsCompilerDirective: Boolean;
begin
  Result := True;
  s := Token.Value;
  if s[1] = '/' then Exit; // single line comment are not parsed

 // remove comment brackets
  if s[1] = '(' then BracketCount := 2 else BracketCount := 1;
  System.Delete(s, 1, BracketCount);
  System.Delete(s, Length(s) - BracketCount + 1, BracketCount);
  if Pointer(s) = nil then Exit; // <==> if Length(s) = 0 then Exit;

  IsCompilerDirective := (s[1] = '$');

  if (IsCompilerDirective) and (not FConditionalParse or FConditionalParseCode.Last) and
     (StartsText(SMacroStartString, s)) then
  begin
   // register new macro
    System.Delete(s, 1, Length(SMacroStartString));
    Item := RegisterMacroByToken(s, Token);
    if Item <> nil then Define(Item.Name); // define also as conditional
  end

  else if (IsCompilerDirective) and
          (not FConditionalParse or FConditionalParseCode.Last) and
          (StartsText(SUnmacroStartString, s)) then
  begin
   // unregister macro
    System.Delete(s, 1, Length(SUnmacroStartString));
    s := Trim(s);
    UnregisterMacro(s);
    Undefine(s); // undefine conditional
  end

  else if (not IsCompilerDirective) and
          (not FConditionalParse or FConditionalParseCode.Last) and
          (s[1] in ['M', 'm']) and
          (StartsText(SMacroIncludeString, s)) then
  begin
   // parse macro include file

    System.Delete(s, 1, PosChar(' ', s));
    s := Trim(s);
    if s <> '' then
    begin
      if s[1] = '''' then
      begin
        System.Delete(s, 1, 1);
        System.Delete(s, Length(s), 1);
      end;

      FileName := ParseFile(s, ptInterfaceMacros, {TestFileExistence:=}True);
      if Filename = '' then
        Error(Format(SFindFile, [s]), Token);
    end;
  end

  else if (IsCompilerDirective) and
          ({not FConditionalParse or} FConditionalParseCode.Last) and
          ((StartsText('$I ', s)) or (StartsText('$INCLUDE ', s))) then
  begin
   // parse include file

    System.Delete(s, 1, PosChar(' ', s));
    s := Trim(s);
    if s <> '' then
    begin
      if s[1] = '''' then
      begin
        System.Delete(s, 1, 1);
        System.Delete(s, Length(s), 1);
      end;
     // parse include file
      if TPascalParserEx(Token.Parser).NoReplaceMacros then
        Filename := ParseFile(s, ptInterfaceMacros, {TestFileExistence:=}True)
      else
        Filename := ParseFile(s, ptInclude, {TestFileExistence:=}True);
      if Filename = '' then
        //Error(Format(SFindFile, [s]), Token);
        Exit;
      if ExtractFileName(Filename) = ExtractFileName(s) then Exit; // file was not modified so no file name change

      if TPascalParserEx(Token.Parser).NoReplaceMacros then Exit;

     // replace old filename by new one
      ps := Pos(s, Token.Value); // find file name start position
      s := Token.Value;
      ri := ps - 1;
      while (ri > 1) and (not (s[ri] in ['''', ' '])) do Dec(ri);
      Len := Length(s);
      while (ps < Len) and (not (s[ps] in [s[ri], '}', '*'])) do Inc(ps);
      if s[ps] <> '''' then Dec(ps);
      if s[ri] = ' ' then Inc(ri);
      System.Delete(s, ri, ps - ri + 1);
      System.Insert('''' + Filename + '''', s, ri);

      Token.Parser.ReplaceParseNext(Token, Token, s); // replace token
      Token.Parser.ClearCache; // clear cache
    end;

  end else if (IsCompilerDirective) then
  begin
    // compiler directive / conditional compilation

    if ParseConditionals(s, Token.pFilename^, Token.StartLine) then
    begin
      if BracketCount = 1 then s := '{' + s + '}'
                          else s := '(*' + s + '*)';
      Token.Parser.ReplaceParseNext(Token, Token, s); // replace token
      Token.Parser.ClearCache; // clear cache
    end;
  end;
end;


{ ParseUsesIdent() parses the USES statement and add all found units who's
  file exists to the FUnits-List. No duplicate files are added. }
procedure TMacros.ParseUsesIdent(Parser: TPascalParserEx);
var
  Token: PTokenInfo;
  s: string;
  UnitIndex: Integer;
begin
  while NextToken(Parser, Token) do // NextToken() replaces macros
  begin
    if Token.Kind = tkSymbol then
    begin
      if Token.Value = ';' then Break
      else if Token.Value = ',' then Continue;
    end

    else if Token.Kind = tkIdent then
    begin
      if SameText(Token.Value, 'in') then
      begin
        Token := NextToken(Parser); // NextToken() replaces macros
        s := RemoveQuotes(Token.Value);
      end else s := Token.Value + '.pas';

      s := FFileSys.FindFile(s, {IsInclude:=}False);
      if s <> '' then
      begin
        UnitIndex := IndexOfFilename(FUnits, s);
       // add this unit to the unit-parse-list.
        if UnitIndex = -1 then
          UnitIndex := FUnits.AddObject(s, Pointer(-1));

       // Include the macros from the interface section of the the new unit.
        ParseUnitMacroFile(UnitIndex);

       // Include the macro include file for the new unit.
        ParseUnitMacroFile(UnitIndex);
      end;
    end;
  end;
end;


{ GetReplacement() is called for "Function Macros" only. It replaces the
  arguments of the macro item with Args[] which is created in ReplaceMacros().
  All macros in Args[] are replaced when entering this method. }
function TMacros.GetReplacement(Item: TMacroItem; const Args: TStringDynArray;
  const Filename: string; StartLineNum: Integer): string;

  function GetArg(Token: PTokenInfo; var Arg: string): Boolean;
  var ArgIndex: Integer;
  begin
   // do not set Args to '' here
    Result := False;
    if (Token = nil) or (Token.Kind <> tkIdent) then Exit;

    ArgIndex := Item.IndexOfArg(Token.Value);
    if ArgIndex >= 0 then
    begin
      Arg := Args[ArgIndex];
      Result := True;
    end;
  end;

var
  Parser: TPascalParserEx;
  StartToken, Token: PTokenInfo;
begin
 // parsing "Macro Replacement" text
  Parser := TPascalParserEx.Create(Filename, Item.Replacement, StartLineNum);
  try
    while Parser.GetToken(Token) do
    begin

      if (Token.Kind = tkIdent) then
      begin
        if GetArg(Token, Token.Value) then
        begin
          StartToken := Token;
         // parse the new content but do not clear cache so it is possilbe
         // for '##' to get the string as identifier
          Parser.ReplaceParseNext(StartToken, Token, Token.Value);
        end;
      end


      else if (Token.Kind = tkSymbol) then
      begin
       // make string
        if Token.Value = '#' then
        begin
          StartToken := Token;
          if (not Parser.GetToken(Token)) then
            Error(Format(SMacroSytaxError, [SNoFurtherToken]), StartToken); // Abort
          if (not GetArg(Token, Token.Value)) then
            Error(Format(SMacroSytaxError, [SCanOnlyMakeStringFromArguments]), StartToken); // Abort

          Token.Value := '''' + Token.Value + '''';
          Parser.ReplaceParseNext(StartToken, Token, Token.Value);
         // parse the new content but do not clear cache so it is possilbe for
         // '##' to get the string as identifier
          Token.StartIndex := StartToken.StartIndex; // adjust tkIdent-token StartIndex becoming PreToken
        end


        else if (Token.Value = '##') then
        begin
          StartToken := Parser.PreToken;
          if (StartToken = nil) or
             (StartToken.Kind <> tkIdent) or
             (not Parser.GetToken(Token)) or
             (Token.Kind <> tkIdent) then  // changes <Token>
            Error(Format(SMacroSytaxError, [SCombineError]), Token); // Abort

          GetArg(Token, Token.Value); // get argument replacement if available

         // parse the new content but do not clear cache so it is possilbe for
         // '##' to get the string as identifier
          Parser.ReplaceParseNext(StartToken, Token, TrimRight(StartToken.Value) + TrimLeft(Token.Value));
          Token.StartIndex := StartToken.StartIndex; // adjust tkIdent-token StartIndex becoming PreToken
        end;
      end; // if Token.Kind = tkSymbol

    end; // while

    Result := Parser.Text;
  finally
    Parser.Free;
  end;
end;


{ ReplaceMacro() creates the argument array and replaces all array items by
  its macro(-function). For macro functions GetReplacement() is called. }
procedure TMacros.ReplaceMacro(Parser: TPascalParserEx; Item: TMacroItem);
var
  Token: PTokenInfo;
  ReplStartIndex, ReplEndIndex, LastCommaIndex: Integer;
  Replacement: string;
  BracketNum: Integer;
  Args: TStringDynArray;
  ArgIndex: Integer;
  AddedLines: Integer;
  EndLineNum: Integer;
begin
  if FMacroMacroRecursion.IndexOf(Item) >= 0 then Exit; // do not replace the macro with itself
  FMacroMacroRecursion.Add(Item);
  try
    Token := Parser.CurToken;
    ReplStartIndex := Token.StartIndex;
    ReplEndIndex := Token.EndIndex;
    EndLineNum := Token.EndLine;
    if Item.HasBrackets then
    begin
     // macro with arguments

     // is '(' the next token
      if (not Parser.GetToken(Token)) or (Token.Value <> '(') then
        Error(Format(SMacroSytaxError, [SNoArgumentSpecified]), Parser.PreToken); // Abort


     // Here we use NextToken(), because the arguments can also be macros and
     // NextToken() replaces them.

     // get macro arguments
      SetLength(Args, Length(Item.Arguments));
      ArgIndex := 0;
      LastCommaIndex := Token.StartIndex;
      BracketNum := 1;
      while NextToken(Parser, Token) do // NextToken() replaces macros
      begin
        EndLineNum := Token.EndLine;
        if Token.Value = '(' then Inc(BracketNum)
        else if Token.Value = ')' then
        begin
          Dec(BracketNum);
          if BracketNum = 0 then
          begin
            if Length(Args) > 0 then
            begin
              Args[ArgIndex] := Trim(Parser.GetPlainText(LastCommaIndex + 1, Token.StartIndex - 1)); // save last argument
              if Length(Args[ArgIndex]) = 0 then
                Error(Format(SMacroSytaxError, [SEmptyMacroArgument]), Token);
            end;
            Break; // last bracket
          end;
        end
        else if (BracketNum = 1) and (Token.Value = ',') then
        begin
          Args[ArgIndex] := Parser.GetPlainText(LastCommaIndex + 1, Token.StartIndex - 1);
          if IsStrEmpty(Args[ArgIndex]) then
            Error(Format(SMacroSytaxError, [SEmptyMacroArgument]), Token);

          LastCommaIndex := Token.StartIndex;
         // new argument
          Inc(ArgIndex);
          if ArgIndex >= Length(Args) then
            Error(SMacroSytaxError, Token);
        end;
      end;
      SetLength(Args, ArgIndex + 1); // set to correct length
      ReplEndIndex := Token.EndIndex; // new end index

     // check arguments
      if Length(Args) <> Length(Item.Arguments) then
        Error(Format(SMacroNotEnoughArguments, [Item.Name]), Token);

      Replacement := GetReplacement(Item, Args, Parser.Filename, Token.StartLine);
    end
    else
      Replacement := Item.Replacement; // just a simple replacement

   // parse replacement
    ParseString(Replacement, Parser.Filename, Parser.LineNum, ptInclude);
   // replace text
    Parser.ReplaceParseNext(ReplStartIndex, ReplEndIndex - ReplStartIndex + 1, Replacement);
    Parser.ClearCache; // new parse start and clear token cache

   // lines moved
    AddedLines := CountChars(#10, Replacement);
    if AddedLines > 0 then
      FFileSys.LinesMoved(Token^.Parser.Filename, EndLineNum, AddedLines);
  finally
    FMacroMacroRecursion.Remove(Item);
  end;
end;


function TMacros.BuiltInMacro(Token: PTokenInfo; var Replacement: string): Boolean;
begin
 // __LINE__
  if FCompare(Token.Value, SBuiltIn_Line) = 0 then
  begin
    Result := True;
    Replacement := IntToStr(Token.StartLine);
  end

 // __FILE__
  else if FCompare(Token.Value, SBuiltIn_File) = 0 then
  begin
    Result := True;
    Replacement := '''' + Token.pFilename^ + ''''
  end

 // __DATE__
  else if FCompare(Token.Value, SBuiltIn_Date) = 0 then
  begin
    Result := True;
    Replacement := '''' + DateToStr(Date) + ''''
  end

 // __TIME__
  else if FCompare(Token.Value, SBuiltIn_Time) = 0 then
  begin
    Result := True;
    Replacement := '''' + TimeToStr(Time) + ''''
  end

  else
  begin
    Result := False;
    if Assigned(FOnBuiltInMacro) then
    begin
      Replacement := '';
      FOnBuiltInMacro(Self, Token, Replacement, Result);
    end;
  end;
end;

procedure TMacros.DefaultConditionals;
begin
  Define('PREPROCESSOR'); // always defined
 //  Define('CONDITIONALEXPRESSIONS');  not supported

{$ifdef VER130}         Define('VER130'); {Delphi 5} {$endif}
{$ifdef VER140}         Define('VER140'); {Delphi 6} {$endif}
{$ifdef VER150}         Define('VER150'); {Delphi 7} {$endif}
{$ifdef VER160}         Define('VER160'); {Delphi 8} {$endif}

{$ifdef MSWINDOWS}      Define('MSWINDOWS'); {$endif}
{$ifdef WIN32}          Define('WIN32'); {$endif}
{$ifdef LINUX}          Define('LINUX'); {$endif}
{$ifdef CPU386}         Define('CPU386'); {$endif}

  if SameText(FAppType, 'CONSOLE') then
    Define('CONSOLE');

 // user defined
  if Assigned(FOnDefaultConditionals) then
    FOnDefaultConditionals(Self);

  Undefine('CONDITIONALEXPRESSIONS'); // not supported
end;

procedure TMacros.Define(const Condition: string);
begin
  if (Condition <> '') and (FConditionals.IndexOf(Condition) = -1) then
    FConditionals.Add(Condition);
end;

procedure TMacros.Undefine(const Condition: string);
var Index: Integer;
begin
  Index := FConditionals.IndexOf(Condition);
  if Index >= 0 then FConditionals.Delete(Index);
end;

function TMacros.IsDefined(const Condition: string): Boolean;
begin
  Result := (Condition <> '') and (FConditionals.IndexOf(Condition) >= 0);
end;

procedure TMacros.SetOption(const Option: string; Value: Boolean);
begin
{TODO set options for $ifopt, be carefull with $R+/- and $RANGECHECKS ON/OFF and so on}
end;

end.