{
 ***************************************************************************
 *                                                                         *
 *   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:
    TLinkScanner scans a source file, reacts to compiler directives, replaces
    macros and reads include files. It builds one source and a link list. The
    resulting source is called the cleaned source. A link points from a position
    of the cleaned source to its position in the real source.
    The link list makes it possible to change scanned code in the source files.

  ToDo:
    - macros
}
unit LinkScanner;

{$ifdef FPC} {$mode objfpc} {$endif}{$H+}

{$I codetools.inc}

{ $DEFINE ShowIgnoreErrorAfter}

// debugging
{ $DEFINE ShowUpdateCleanedSrc}
{ $DEFINE VerboseIncludeSearch}

interface

uses
  {$IFDEF MEM_CHECK}
  MemCheck,
  {$ENDIF}
  Classes, SysUtils, CodeToolsStrConsts, CodeToolMemManager, FileProcs,
  ExprEval, SourceLog, KeywordFuncLists, BasicCodeTools;

const
  PascalCompilerDefine = ExternalMacroStart+'Compiler';
  NestedCompilerDefine = ExternalMacroStart+'NestedComments';

  MissingIncludeFileCode = Pointer(1);

type
  TLinkScanner = class;

//----------------------------------------------------------------------------
  TOnGetSource = function(Sender: TObject; Code: Pointer): TSourceLog
                 of object;
  TOnLoadSource = function(Sender: TObject; const AFilename: string;
                       OnlyIfExists: boolean): pointer of object;
  TOnGetSourceStatus = procedure(Sender: TObject; Code: Pointer;
                 var ReadOnly: boolean) of object;
  TOnDeleteSource = procedure(Sender: TObject; Code: Pointer; Pos, Len: integer)
                    of object;
  TOnGetFileName = function(Sender: TObject; Code: Pointer): string of object;
  TOnCheckFileOnDisk = function(Code: Pointer): boolean of object;
  TOnGetInitValues = function(Code: Pointer;
                       var ChangeStep: integer): TExpressionEvaluator of object;
  TOnIncludeCode = procedure(ParentCode, IncludeCode: Pointer) of object;
  TOnSetWriteLock = procedure(Lock: boolean) of object;
  TOnGetWriteLockInfo = procedure(var WriteLockIsSet: boolean;
    var WriteLockStep: integer) of object;

  { TSourceLink is used to map between the codefiles and the cleaned source }
  PSourceLink = ^TSourceLink;
  TSourceLink = record
    CleanedPos: integer;
    SrcPos: integer;
    Code: Pointer;
    Next: PSourceLink;
  end;

  { TSourceChangeStep is used save the ChangeStep of every used file }
  PSourceChangeStep = ^TSourceChangeStep;
  TSourceChangeStep = record
    Code: Pointer;
    ChangeStep: integer;
    Next: PSourceChangeStep;
  end;

  TCommentStyle = (CommentNone, CommentTP, CommentOldTP, CommentDelphi);

  TCompilerMode = (cmFPC, cmDELPHI, cmGPC, cmTP, cmOBJFPC, cmMacPas);
  TPascalCompiler = (pcFPC, pcDelphi);

  { TMissingIncludeFile is a missing include file together with all
    params involved in the search }
  TMissingIncludeFile = class
  public
    IncludePath: string;
    Filename: string;
    constructor Create(const AFilename, AIncludePath: string);
  end;
  
  { TMissingIncludeFiles is a list of TMissingIncludeFile }
  TMissingIncludeFiles = class(TList)
  private
    function GetIncFile(Index: Integer): TMissingIncludeFile;
    procedure SetIncFile(Index: Integer; const AValue: TMissingIncludeFile);
  public
    procedure Clear; override;
    procedure Delete(Index: Integer);
    property Items[Index: Integer]: TMissingIncludeFile
      read GetIncFile write SetIncFile; default;
  end;
  
  { LinkScanner Token Types }
  TLSTokenType = (
    lsttNone, lsttSrcEnd, lsttIdentifier, lsttEqual, lsttPoint, lsttEnd,
    lsttEndOfInterface);

  { Error handling }
  ELinkScannerError = class(Exception)
    Sender: TLinkScanner;
    constructor Create(ASender: TLinkScanner; const AMessage: string);
  end;
  
  ELinkScannerErrors = class of ELinkScannerError;
  
  TLinkScannerProgress = function(Sender: TLinkScanner): boolean of object;
  
  ELinkScannerAbort = class(ELinkScannerError)
  end;
  
  ELinkScannerEditError = class(ELinkScannerError)
    Buffer: Pointer;
    BufferPos: integer;
    constructor Create(ASender: TLinkScanner; const AMessage: string;
      ABuffer: Pointer; ABufferPos: integer);
  end;


  { TLinkScanner }
  
  TLinkScanner = class(TObject)
  private
    FLinks: PSourceLink; // list of TSourceLink
    FLinkCount: integer;
    FLinkCapacity: integer;
    FCleanedSrc: string;
    FLastCleanedSrcLen: integer;
    FOnGetSource: TOnGetSource;
    FOnGetFileName: TOnGetFileName;
    FOnGetSourceStatus: TOnGetSourceStatus;
    FOnLoadSource: TOnLoadSource;
    FOnDeleteSource: TOnDeleteSource;
    FOnCheckFileOnDisk: TOnCheckFileOnDisk;
    FOnGetInitValues: TOnGetInitValues;
    FOnIncludeCode: TOnIncludeCode;
    FOnProgress: TLinkScannerProgress;
    FIgnoreErrorAfterCode: Pointer;
    FIgnoreErrorAfterCursorPos: integer;
    FInitValues: TExpressionEvaluator;
    FInitValuesChangeStep: integer;
    FSourceChangeSteps: TFPList; // list of PSourceChangeStep sorted with Code
    FChangeStep: integer;
    FMainSourceFilename: string;
    FMainCode: pointer;
    FScanTillInterfaceEnd: boolean;
    FIgnoreMissingIncludeFiles: boolean;
    FNestedComments: boolean;
    FForceUpdateNeeded: boolean;
    // global write lock
    FLastGlobalWriteLockStep: integer;
    FOnGetGlobalWriteLockInfo: TOnGetWriteLockInfo;
    FOnSetGlobalWriteLock: TOnSetWriteLock;
    function GetLinks(Index: integer): TSourceLink;
    procedure SetLinks(Index: integer; const Value: TSourceLink);
    procedure SetSource(ACode: Pointer); // set current source
    procedure AddSourceChangeStep(ACode: pointer; AChangeStep: integer);
    procedure AddLink(ACleanedPos, ASrcPos: integer; ACode: Pointer);
    procedure IncreaseChangeStep;
    procedure SetMainCode(const Value: pointer);
    procedure SetScanTillInterfaceEnd(const Value: boolean);
    procedure SetIgnoreMissingIncludeFiles(const Value: boolean);
    function TokenIs(const AToken: shortstring): boolean;
    function UpTokenIs(const AToken: shortstring): boolean;
  private
    // parsing
    CommentStyle: TCommentStyle;
    CommentLevel: integer;
    CommentStartPos: integer;      // position of '{', '(*', '//'
    CommentInnerStartPos: integer; // position after '{', '(*', '//'
    CommentInnerEndPos: integer;   // position of '}', '*)', #10
    CommentEndPos: integer;        // postion after '}', '*)', #10
    LastCleanSrcPos: integer;
    IfLevel: integer;
    KeywordFuncList: TKeyWordFunctionList;
    procedure ReadNextToken;
    function ReadIdentifier: string;
    function ReadUpperIdentifier: string;
    procedure SkipSpace;
    procedure SkipComment;
    procedure SkipDelphiComment;
    procedure SkipOldTPComment;
    procedure CommentEndNotFound;
    procedure EndComment;
    procedure IncCommentLevel;
    procedure DecCommentLevel;
    procedure HandleDirectives;
    procedure UpdateCleanedSource(SourcePos: integer);
    function ReturnFromIncludeFile: boolean;
    procedure InitKeyWordList;
    function DoEndToken: boolean;
    function DoDefaultIdentToken: boolean;
    function DoEndOfInterfaceToken: boolean;
  private
    // directives
    FDirectiveName: shortstring;
    FDirectiveFuncList: TKeyWordFunctionList;
    FSkipDirectiveFuncList: TKeyWordFunctionList;
    FMacrosOn: boolean;
    FMissingIncludeFiles: TMissingIncludeFiles;
    FIncludeStack: TFPList; // list of TSourceLink
    FSkippingTillEndif: boolean;
    FSkipIfLevel: integer;
    FCompilerMode: TCompilerMode;
    FPascalCompiler: TPascalCompiler;
    procedure SetCompilerMode(const AValue: TCompilerMode);
    procedure SkipTillEndifElse;
    function SkipIfDirective: boolean;
    function IfdefDirective: boolean;
    function IfndefDirective: boolean;
    function IfDirective: boolean;
    function IfOptDirective: boolean;
    function EndifDirective: boolean;
    function ElseDirective: boolean;
    function ElseIfDirective: boolean;
    function IfEndDirective: boolean;
    function DefineDirective: boolean;
    function UndefDirective: boolean;
    function IncludeDirective: boolean;
    function IncludeFile(const AFilename: string): boolean;
    function IncludePathDirective: boolean;
    function LoadSourceCaseSensitive(const AFilename: string): pointer;
    function SearchIncludeFile(const AFilename: string; var NewCode: Pointer;
      var MissingIncludeFile: TMissingIncludeFile): boolean;
    function ShortSwitchDirective: boolean;
    function ReadNextSwitchDirective: boolean;
    function LongSwitchDirective: boolean;
    function ModeDirective: boolean;
    function ThreadingDirective: boolean;
    procedure BuildDirectiveFuncList;
    procedure PushIncludeLink(ACleanedPos, ASrcPos: integer; ACode: Pointer);
    function PopIncludeLink: TSourceLink;
    function GetIncludeFileIsMissing: boolean;
    function MissingIncludeFilesNeedsUpdate: boolean;
    procedure ClearMissingIncludeFiles;
  protected
    // errors
    LastErrorMessage: string;
    LastErrorSrcPos: integer;
    LastErrorCode: pointer;
    LastErrorIsValid: boolean;
    LastErrorBehindIgnorePosition: boolean;
    LastErrorCheckedForIgnored: boolean;
    CleanedIgnoreErrorAfterPosition: integer;
    procedure RaiseExceptionFmt(const AMessage: string; Args: array of const);
    procedure RaiseException(const AMessage: string);
    procedure RaiseExceptionClass(const AMessage: string;
      ExceptionClass: ELinkScannerErrors);
    procedure RaiseEditException(const AMessage: string; ABuffer: Pointer;
      ABufferPos: integer);
    procedure ClearLastError;
    procedure RaiseLastError;
    procedure DoCheckAbort;
  public
    // current values, positions, source, flags
    CleanedLen: integer;
    Src: string;     // current parsed source
    SrcPos: integer; // current position
    TokenStart: integer; // start position of current token
    TokenType: TLSTokenType;
    SrcLen: integer; // length of current source
    Code: pointer;   // current code object
    Values: TExpressionEvaluator;

    EndOfInterfaceFound: boolean;
    EndOfSourceFound: boolean;
    
    function MainFilename: string;

    // links
    property Links[Index: integer]: TSourceLink read GetLinks write SetLinks;
    function LinkCount: integer;
    function LinkIndexAtCleanPos(ACleanPos: integer): integer;
    function LinkIndexAtCursorPos(ACursorPos: integer; ACode: Pointer): integer;
    function LinkSize(Index: integer): integer;
    function LinkCleanedEndPos(Index: integer): integer;
    function FindFirstSiblingLink(LinkIndex: integer): integer;
    function FindParentLink(LinkIndex: integer): integer;
    function LinkIndexNearCursorPos(ACursorPos: integer; ACode: Pointer;
                                    var CursorInLink: boolean): integer;

    // source mapping (Cleaned <-> Original)
    function CleanedSrc: string;
    function CursorToCleanPos(ACursorPos: integer; ACode: pointer;
                    var ACleanPos: integer): integer; // 0=valid CleanPos
                          //-1=CursorPos was skipped, CleanPos between two links
                          // 1=CursorPos beyond scanned code
    function CleanedPosToCursor(ACleanedPos: integer; var ACursorPos: integer;
                                var ACode: Pointer): boolean;
    function LastErrorsInFrontOfCleanedPos(ACleanedPos: integer): boolean;
    procedure RaiseLastErrorIfInFrontOfCleanedPos(ACleanedPos: integer);

    // ranges
    function WholeRangeIsWritable(CleanStartPos, CleanEndPos: integer;
                                  ErrorOnFail: boolean): boolean;
    procedure FindCodeInRange(CleanStartPos, CleanEndPos: integer;
                              UniqueSortedCodeList: TFPList);
    procedure DeleteRange(CleanStartPos,CleanEndPos: integer);

    // scanning
    procedure Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean);
    function UpdateNeeded(OnlyInterfaceNeeded,
                          CheckFilesOnDisk: boolean): boolean;
    procedure SetIgnoreErrorAfter(ACursorPos: integer; ACode: Pointer);
    procedure ClearIgnoreErrorAfter;
    function IgnoreErrAfterPositionIsInFrontOfLastErrMessage: boolean;
    function IgnoreErrorAfterCleanedPos: integer;
    function IgnoreErrorAfterValid: boolean;

    function GuessMisplacedIfdefEndif(StartCursorPos: integer;
                                      StartCode: pointer;
                                      var EndCursorPos: integer;
                                      var EndCode: Pointer): boolean;

    property ChangeStep: integer read FChangeStep;

    // global write lock
    procedure ActivateGlobalWriteLock;
    procedure DeactivateGlobalWriteLock;
    property OnGetGlobalWriteLockInfo: TOnGetWriteLockInfo
                 read FOnGetGlobalWriteLockInfo write FOnGetGlobalWriteLockInfo;
    property OnSetGlobalWriteLock: TOnSetWriteLock
                         read FOnSetGlobalWriteLock write FOnSetGlobalWriteLock;

    // properties
    property OnGetSource: TOnGetSource read FOnGetSource write FOnGetSource;
    property OnLoadSource: TOnLoadSource read FOnLoadSource write FOnLoadSource;
    property OnDeleteSource: TOnDeleteSource
                                     read FOnDeleteSource write FOnDeleteSource;
    property OnGetSourceStatus: TOnGetSourceStatus
                               read FOnGetSourceStatus write FOnGetSourceStatus;
    property OnGetFileName: TOnGetFileName
                                       read FOnGetFileName write FOnGetFileName;
    property OnCheckFileOnDisk: TOnCheckFileOnDisk
                               read FOnCheckFileOnDisk write FOnCheckFileOnDisk;
    property OnGetInitValues: TOnGetInitValues
                                   read FOnGetInitValues write FOnGetInitValues;
    property OnIncludeCode: TOnIncludeCode
                                       read FOnIncludeCode write FOnIncludeCode;
    property OnProgress: TLinkScannerProgress
                                             read FOnProgress write FOnProgress;
    property IgnoreMissingIncludeFiles: boolean read FIgnoreMissingIncludeFiles
                                             write SetIgnoreMissingIncludeFiles;
    property InitialValues: TExpressionEvaluator
                                             read FInitValues write FInitValues;
    property MainCode: pointer read FMainCode write SetMainCode;
    property IncludeFileIsMissing: boolean read GetIncludeFileIsMissing;
    property NestedComments: boolean read FNestedComments;
    property CompilerMode: TCompilerMode
                                       read FCompilerMode write SetCompilerMode;
    property PascalCompiler: TPascalCompiler
                                     read FPascalCompiler write FPascalCompiler;
    property ScanTillInterfaceEnd: boolean read FScanTillInterfaceEnd
                                           write SetScanTillInterfaceEnd;
        
    procedure Clear;
    function ConsistencyCheck: integer;
    procedure WriteDebugReport;
    constructor Create;
    destructor Destroy; override;
  end;

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

  // memory system for PSourceLink(s)
  TPSourceLinkMemManager = class(TCodeToolMemManager)
  protected
    procedure FreeFirstItem; override;
  public
    procedure DisposePSourceLink(Link: PSourceLink);
    function NewPSourceLink: PSourceLink;
  end;

  // memory system for PSourceLink(s)
  TPSourceChangeStepMemManager = class(TCodeToolMemManager)
  protected
    procedure FreeFirstItem; override;
  public
    procedure DisposePSourceChangeStep(Step: PSourceChangeStep);
    function NewPSourceChangeStep: PSourceChangeStep;
  end;

//----------------------------------------------------------------------------
// compiler switches
const
  CompilerSwitchesNames: array['A'..'Z'] of shortstring=(
         'ALIGN'          // A
        ,'BOOLEVAL'       // B
        ,'ASSERTIONS'     // C
        ,'DEBUGINFO'      // D
        ,''               // E
        ,''               // F
        ,''               // G
        ,'LONGSTRINGS'    // H
        ,'IOCHECKS'       // I
        ,''               // J
        ,''               // K
        ,'LOCALSYMBOLS'   // L
        ,'TYPEINFO'       // M
        ,''               // N
        ,''               // O
        ,'OPENSTRINGS'    // P
        ,'OVERFLOWCHECKS' // Q
        ,'RANGECHECKS'    // R
        ,''               // S
        ,'TYPEADDRESS'    // T
        ,''               // U
        ,'VARSTRINGCHECKS'// V
        ,'STACKFRAMES'    // W
        ,'EXTENDEDSYNTAX' // X
        ,'REFERENCEINFO'  // Y
        ,''               // Z
     );

const
  CompilerModeNames: array[TCompilerMode] of shortstring=(
        'FPC', 'DELPHI', 'GPC', 'TP', 'OBJFPC', 'MACPAS'
     );
  PascalCompilerNames: array[TPascalCompiler] of shortstring=(
        'FPC', 'DELPHI'
     );

var
  CompilerModeVars: array[TCompilerMode] of shortstring;

  IsSpaceChar, IsLineEndChar, IsWordChar, IsIdentStartChar, IsIdentChar,
  IsNumberChar, IsCommentStartChar, IsCommentEndChar, IsHexNumberChar,
  IsEqualOperatorStartChar, IsAfterFloatPointChar:
    array[char] of boolean;
    
  PSourceLinkMemManager: TPSourceLinkMemManager;
  PSourceChangeStepMemManager: TPSourceChangeStepMemManager;


procedure AddCodeToUniqueList(ACode: Pointer; UniqueSortedCodeList: TFPList);
function IndexOfCodeInUniqueList(ACode: Pointer;
                                 UniqueSortedCodeList: TList): integer;
function IndexOfCodeInUniqueList(ACode: Pointer;
                                 UniqueSortedCodeList: TFPList): integer;


implementation


// useful procs ----------------------------------------------------------------

function IndexOfCodeInUniqueList(ACode: Pointer;
  UniqueSortedCodeList: TList): integer;
var l,m,r: integer;
begin
  l:=0;
  r:=UniqueSortedCodeList.Count-1;
  m:=0;
  while r>=l do begin
    m:=(l+r) shr 1;
    if ACode<UniqueSortedCodeList[m] then
      r:=m-1
    else if ACode>UniqueSortedCodeList[m] then
      l:=m+1
    else begin
      Result:=m;
      exit;
    end;
  end;
  Result:=-1;
end;

function IndexOfCodeInUniqueList(ACode: Pointer;
  UniqueSortedCodeList: TFPList): integer;
var l,m,r: integer;
begin
  l:=0;
  r:=UniqueSortedCodeList.Count-1;
  m:=0;
  while r>=l do begin
    m:=(l+r) shr 1;
    if ACode<UniqueSortedCodeList[m] then
      r:=m-1
    else if ACode>UniqueSortedCodeList[m] then
      l:=m+1
    else begin
      Result:=m;
      exit;
    end;
  end;
  Result:=-1;
end;

procedure AddCodeToUniqueList(ACode: Pointer; UniqueSortedCodeList: TFPList);
var l,m,r: integer;
begin
  l:=0;
  r:=UniqueSortedCodeList.Count-1;
  m:=0;
  while r>=l do begin
    m:=(l+r) shr 1;
    if ACode<UniqueSortedCodeList[m] then
      r:=m-1
    else if ACode>UniqueSortedCodeList[m] then
      l:=m+1
    else
      exit;
  end;
  if (m<UniqueSortedCodeList.Count) and (ACode>UniqueSortedCodeList[m]) then
    inc(m);
  UniqueSortedCodeList.Insert(m,ACode);
end;

function CompareUpToken(const UpToken: shortstring; const Txt: string;
  TxtStartPos, TxtEndPos: integer): boolean;
var len, i: integer;
begin
  Result:=false;
  len:=TxtEndPos-TxtStartPos;
  if len<>length(UpToken) then exit;
  i:=1;
  while i<len do begin
    if (UpToken[i]<>UpChars[Txt[TxtStartPos]]) then exit;
    inc(i);
    inc(TxtStartPos);
  end;
  Result:=true;
end;

function CompareUpToken(const UpToken: ansistring; const Txt: string;
  TxtStartPos, TxtEndPos: integer): boolean;
var len, i: integer;
begin
  Result:=false;
  len:=TxtEndPos-TxtStartPos;
  if len<>length(UpToken) then exit;
  i:=1;
  while i<len do begin
    if (UpToken[i]<>UpChars[Txt[TxtStartPos]]) then exit;
    inc(i);
    inc(TxtStartPos);
  end;
  Result:=true;
end;



{ TLinkScanner }

procedure TLinkScanner.AddLink(ACleanedPos, ASrcPos: integer; ACode: pointer);
var
  NewCapacity: Integer;
begin
  if FLinkCount=FLinkCapacity then begin
    NewCapacity:=FLinkCapacity*2;
    if NewCapacity<16 then NewCapacity:=16;
    ReAllocMem(FLinks,NewCapacity*SizeOf(TSourceLink));
    FLinkCapacity:=NewCapacity;
  end;
  with FLinks[FLinkCount] do begin
    CleanedPos:=ACleanedPos;
    SrcPos:=ASrcPos;
    Code:=ACode;
  end;
  inc(FLinkCount);
end;

function TLinkScanner.CleanedSrc: string;
begin
  if length(FCleanedSrc)<>CleanedLen then begin
    SetLength(FCleanedSrc,CleanedLen);
  end;
  Result:=FCleanedSrc;
  if FLastCleanedSrcLen<CleanedLen then FLastCleanedSrcLen:=CleanedLen;
end;

procedure TLinkScanner.Clear;
var i: integer;
  PLink: PSourceLink;
  PStamp: PSourceChangeStep;
begin
  ClearLastError;
  ClearMissingIncludeFiles;
  for i:=0 to FIncludeStack.Count-1 do begin
    PLink:=PSourceLink(FIncludeStack[i]);
    PSourceLinkMemManager.DisposePSourceLink(PLink);
  end;
  FIncludeStack.Clear;
  FLinkCount:=0;
  FCleanedSrc:='';
  for i:=0 to FSourceChangeSteps.Count-1 do begin
    PStamp:=PSourceChangeStep(FSourceChangeSteps[i]);
    PSourceChangeStepMemManager.DisposePSourceChangeStep(PStamp);
  end;
  FSourceChangeSteps.Clear;
  IncreaseChangeStep;
end;

constructor TLinkScanner.Create;
begin
  inherited Create;
  FInitValues:=TExpressionEvaluator.Create;
  Values:=TExpressionEvaluator.Create;
  FChangeStep:=0;
  FSourceChangeSteps:=TFPList.Create;
  FMainCode:=nil;
  FMainSourceFilename:='';
  BuildDirectiveFuncList;
  FIncludeStack:=TFPList.Create;
  FNestedComments:=false;
end;

procedure TLinkScanner.DecCommentLevel;
begin
  if FNestedComments then dec(CommentLevel)
  else CommentLevel:=0;
end;

destructor TLinkScanner.Destroy;
begin
  Clear;
  KeywordFuncList.Free;
  FIncludeStack.Free;
  FSourceChangeSteps.Free;
  Values.Free;
  FInitValues.Free;
  ReAllocMem(FLinks,0);
  FDirectiveFuncList.Free;
  FSkipDirectiveFuncList.Free;
  inherited Destroy;
end;

function TLinkScanner.GetLinks(Index: integer): TSourceLink;
begin
  Result:=FLinks[Index];
end;

function TLinkScanner.LinkSize(Index: integer): integer;

  procedure IndexOutOfBounds;
  begin
    RaiseException('TLinkScanner.LinkSize  index '
       +IntToStr(Index)+' out of bounds: 0-'+IntToStr(LinkCount));
  end;

begin
  if (Index<0) or (Index>=LinkCount) then
    IndexOutOfBounds;
  if Index<LinkCount-1 then
    Result:=FLinks[Index+1].CleanedPos-FLinks[Index].CleanedPos
  else
    Result:=CleanedLen-FLinks[Index].CleanedPos;
end;

function TLinkScanner.LinkCleanedEndPos(Index: integer): integer;
begin
  Result:=FLinks[Index].CleanedPos+LinkSize(Index);
end;

function TLinkScanner.FindFirstSiblingLink(LinkIndex: integer): integer;
{ find link at the start of the code
  e.g. The resulting link SrcPos is always 1
  
   if LinkIndex is in the main code, the result will be 0
   if LinkIndex is in an include file, the result will be the first link of
   the include file. If the include file is included multiple times, it is
   treated as if they are different files.

  ToDo: if include file includes itself, directly or indirectly
}
var
  LastIndex: integer;
begin
  Result:=LinkIndex;
  if LinkIndex>=0 then begin
    LastIndex:=LinkIndex;
    while (Result>=0) do begin
      if FLinks[Result].Code=FLinks[LinkIndex].Code then begin
        if Links[Result].SrcPos>FLinks[LastIndex].SrcPos then begin
          // the include file was (in-)directly included by itself
          // -> skip
          Result:=FindParentLink(Result);
        end else if FLinks[Result].SrcPos=1 then begin
          // start found
          exit;
        end;
        LastIndex:=Result;
      end;
      dec(Result);
    end;
  end;
end;

function TLinkScanner.FindParentLink(LinkIndex: integer): integer;
// a parent link is the link of the include directive
// or in other words: the link in front of the first sibling link
begin
  Result:=FindFirstSiblingLink(LinkIndex);
  if Result>=0 then dec(Result);
end;

function TLinkScanner.LinkIndexNearCursorPos(ACursorPos: integer;
  ACode: Pointer; var CursorInLink: boolean): integer;
// returns the nearest link at cursorpos
// (either covering the cursorpos or in front)
var
  CurLinkSize: integer;
  BestLinkIndex: integer;
begin
  BestLinkIndex:=-1;
  Result:=0;
  CursorInLink:=false;
  while Result<LinkCount do begin
    if (ACode=FLinks[Result].Code) and (ACursorPos>=FLinks[Result].SrcPos) then
    begin
      CurLinkSize:=LinkSize(Result);
      if ACursorPos<FLinks[Result].SrcPos+CurLinkSize then begin
        CursorInLink:=true;
        exit;
      end else begin
        if (BestLinkIndex<0)
        or (FLinks[BestLinkIndex].SrcPos<FLinks[Result].SrcPos) then begin
          BestLinkIndex:=Result;
        end;
      end;
    end;
    inc(Result);
  end;
  Result:=BestLinkIndex;
end;

function TLinkScanner.LinkIndexAtCleanPos(ACleanPos: integer): integer;

  procedure ConsistencyError1;
  begin
    raise Exception.Create(
      'TLinkScanner.LinkAtCleanPos Consistency-Error 1');
  end;

  procedure ConsistencyError2;
  begin
    raise Exception.Create(
      'TLinkScanner.LinkAtCleanPos Consistency-Error 2');
  end;

var l,r,m: integer;
begin
  Result:=-1;
  if (ACleanPos<1) or (ACleanPos>CleanedLen) then exit;
  // binary search through the links
  l:=0;
  r:=LinkCount-1;
  while l<=r do begin
    m:=(l+r) div 2;
    if m<LinkCount-1 then begin
      if ACleanPos<FLinks[m].CleanedPos then
        r:=m-1
      else if ACleanPos>=FLinks[m+1].CleanedPos then
        l:=m+1
      else begin
        Result:=m;
        exit;
      end;
    end else begin
      if ACleanPos>=FLinks[m].CleanedPos then begin
        Result:=m;
        exit;
      end else
        ConsistencyError2;
    end;
  end;
  ConsistencyError1;
end;

function TLinkScanner.LinkIndexAtCursorPos(ACursorPos: integer; ACode: Pointer
  ): integer;
var
  CurLinkSize: integer;
begin
  Result:=0;
  while Result<LinkCount do begin
    if (ACode=FLinks[Result].Code) and (ACursorPos>=FLinks[Result].SrcPos) then begin
      CurLinkSize:=LinkSize(Result);
      if ACursorPos<FLinks[Result].SrcPos+CurLinkSize then begin
        exit;
      end;
    end;
    inc(Result);
  end;
  Result:=-1;
end;

procedure TLinkScanner.SetSource(ACode: pointer);

  procedure RaiseUnableToGetCode;
  begin
    RaiseException('unable to get source with Code='+DbgS(Code));
  end;

var SrcLog: TSourceLog;
begin
  if Assigned(FOnGetSource) then begin
    SrcLog:=FOnGetSource(Self,ACode);
    if SrcLog=nil then
      RaiseUnableToGetCode;
    AddSourceChangeStep(ACode,SrcLog.ChangeStep);
    Src:=SrcLog.Source;
    Code:=ACode;
    SrcPos:=1;
    TokenStart:=1;
    TokenType:=lsttNone;
    SrcLen:=length(Src);
    LastCleanSrcPos:=0;
  end else begin
    RaiseUnableToGetCode;
  end;
end;

procedure TLinkScanner.HandleDirectives;
var DirStart, DirLen: integer;
begin
  SrcPos:=CommentInnerStartPos+1;
  DirStart:=SrcPos;
  while (SrcPos<=SrcLen) and (IsIdentStartChar[Src[SrcPos]]) do
    inc(SrcPos);
  DirLen:=SrcPos-DirStart;
  if DirLen>255 then DirLen:=255;
  FDirectiveName:=UpperCaseStr(copy(Src,DirStart,DirLen));
  FDirectiveFuncList.DoIt(Src,DirStart,DirLen);
  SrcPos:=CommentEndPos;
end;

procedure TLinkScanner.IncCommentLevel;
begin
  if FNestedComments then inc(CommentLevel)
  else CommentLevel:=1;
end;

procedure TLinkScanner.IncreaseChangeStep;
begin
  if FChangeStep=$7fffffff then FChangeStep:=-$7fffffff
  else inc(FChangeStep);
end;

function TLinkScanner.LinkCount: integer;
begin
  Result:=FLinkCount;
end;

procedure TLinkScanner.ReadNextToken;

  function ReturnFromIncludeFileAndCheck: boolean;
  begin
    Result:=false;
    if not ReturnFromIncludeFile then begin
      SrcPos:=SrcLen+1; // make sure SrcPos stands somewhere
      TokenStart:=SrcPos;
      TokenType:=lsttSrcEnd;
      Result:=true;
    end;
  end;

var
  c1: char;
  c2: char;
begin
  // Skip all spaces and comments
  //DebugLn(' TLinkScanner.ReadNextToken SrcPos=',SrcPos,' SrcLen=',SrcLen,' "',copy(Src,SrcPos,5),'"');
  if (SrcPos>SrcLen) and ReturnFromIncludeFileAndCheck then exit;
  c1:=Src[SrcPos];
  if IsCommentStartChar[c1] or IsSpaceChar[c1] then begin
    while true do begin
      if IsCommentStartChar[c1] then begin
        case c1 of
        '{' :
          SkipComment;
        '/':
          if (SrcPos<SrcLen) and (Src[SrcPos+1]='/') then
            SkipDelphiComment
          else
            break;
        '(':
          if (SrcPos<SrcLen) and (Src[SrcPos+1]='*') then
            SkipOldTPComment
          else
            break;
        end;
      end else if IsSpaceChar[c1] then begin
        repeat
          inc(SrcPos);
        until (SrcPos>SrcLen) or (not (IsSpaceChar[Src[SrcPos]]));
      end else
        break;
      if (SrcPos>SrcLen) and ReturnFromIncludeFileAndCheck then exit;
      c1:=Src[SrcPos];
    end;
  end;
  TokenStart:=SrcPos;
  TokenType:=lsttNone;
  // read token
  case c1 of
    '_','A'..'Z','a'..'z':
      begin
        // identifier
        inc(SrcPos);
        while (SrcPos<=SrcLen)
        and (IsIdentChar[Src[SrcPos]]) do
          inc(SrcPos);
        KeywordFuncList.DoIt(Src,TokenStart,SrcPos-TokenStart);
      end;
    '''','#':
      begin
        while (SrcPos<=SrcLen) do begin
          case (Src[SrcPos]) of
          '#':
            begin
              inc(SrcPos);
              while (SrcPos<=SrcLen)
              and (IsNumberChar[Src[SrcPos]]) do
                inc(SrcPos);
            end;
          '''':
            begin
              inc(SrcPos);
              while (SrcPos<=SrcLen) do begin
                case Src[SrcPos] of
                '''':
                  begin
                    inc(SrcPos);
                    break;
                  end;
                #10,#13:
                  break;
                else
                  inc(SrcPos);
                end;
              end;
            end;
          else
            break;
          end;
        end;
      end;
    '0'..'9':
      begin
        inc(SrcPos);
        while (SrcPos<=SrcLen) and (IsNumberChar[Src[SrcPos]]) do
          inc(SrcPos);
        if (SrcPos<SrcLen) and (Src[SrcPos]='.') and (Src[SrcPos+1]<>'.')
        then begin
          // real type number
          inc(SrcPos);
          while (SrcPos<=SrcLen) and (IsNumberChar[Src[SrcPos]]) do
            inc(SrcPos);
          if (SrcPos<=SrcLen) and (Src[SrcPos] in ['E','e']) then begin
            // read exponent
            inc(SrcPos);
            if (SrcPos<=SrcLen) and (Src[SrcPos] in ['-','+']) then inc(SrcPos);
            while (SrcPos<=SrcLen) and (IsNumberChar[Src[SrcPos]]) do
              inc(SrcPos);
          end;
        end;
      end;
    '%':
      begin
        inc(SrcPos);
        while (SrcPos<=SrcLen) and (Src[SrcPos] in ['0'..'1']) do
          inc(SrcPos);
      end;
    '$':
      begin
        inc(SrcPos);
        while (SrcPos<=SrcLen)
        and (IsHexNumberChar[Src[SrcPos]]) do
          inc(SrcPos);
      end;
    '=':
      begin
        inc(SrcPos);
        TokenType:=lsttEqual;
      end;
    '.':
      begin
        inc(SrcPos);
        TokenType:=lsttPoint;
      end;
    else
      inc(SrcPos);
      if SrcPos<=SrcLen then begin
        c2:=Src[SrcPos];
        // test for double char operators
        //  :=, +=, -=, /=, *=, <>, <=, >=, **, ><, ..
        if ((c2='=') and  (IsEqualOperatorStartChar[c1]))
        or ((c1='<') and (c2='>'))
        or ((c1='>') and (c2='<'))
        or ((c1='.') and (c2='.'))
        or ((c1='*') and (c2='*'))
        then inc(SrcPos);
      end;
  end;
end;

procedure TLinkScanner.Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean);
var
  LastTokenType: TLSTokenType;
  cm: TCompilerMode;
  pc: TPascalCompiler;
  s: string;
  LastProgressPos: integer;
  CheckForAbort: boolean;
  NewSrcLen: Integer;
begin
  if not UpdateNeeded(TillInterfaceEnd,CheckFilesOnDisk) then begin
    // input is the same as last time -> output is the same
    // -> if there was an error, raise it again
    if LastErrorIsValid
    and ((not IgnoreErrorAfterValid)
      or (not IgnoreErrAfterPositionIsInFrontOfLastErrMessage))
    then
      RaiseLastError;
    exit;
  end;
  {$IFDEF CTDEBUG}
  DebugLn('TLinkScanner.Scan A -------- TillInterfaceEnd=',dbgs(TillInterfaceEnd));
  {$ENDIF}
  ScanTillInterfaceEnd:=TillInterfaceEnd;
  Clear;
  IncreaseChangeStep;
  {$IFDEF CTDEBUG}
  DebugLn('TLinkScanner.Scan B ');
  {$ENDIF}
  SetSource(FMainCode);
  NewSrcLen:=length(Src);
  if NewSrcLen<FLastCleanedSrcLen+1000 then
    NewSrcLen:=FLastCleanedSrcLen+1000;
  SetLength(FCleanedSrc,NewSrcLen);
  CleanedLen:=0;
  {$IFDEF CTDEBUG}
  DebugLn('TLinkScanner.Scan C ',dbgs(SrcLen));
  {$ENDIF}
  EndOfInterfaceFound:=false;
  EndOfSourceFound:=false;
  CommentStyle:=CommentNone;
  CommentLevel:=0;
  CompilerMode:=cmFPC;
  PascalCompiler:=pcFPC;
  IfLevel:=0;
  FSkippingTillEndif:=false;
  //DebugLn('TLinkScanner.Scan D --------');
  
  // initialize Defines
  if Assigned(FOnGetInitValues) then
    FInitValues.Assign(FOnGetInitValues(FMainCode,FInitValuesChangeStep));
  Values.Assign(FInitValues);

  // compiler
  s:=FInitValues.Variables[PascalCompilerDefine];
  for pc:=Low(TPascalCompiler) to High(TPascalCompiler) do
    if (s=PascalCompilerNames[pc]) then
      PascalCompiler:=pc;

  // compiler mode
  for cm:=Low(TCompilerMode) to High(TCompilerMode) do
    if FInitValues.IsDefined(CompilerModeVars[cm]) then
      CompilerMode:=cm;

  // nested comments
  FNestedComments:=false;
  if (PascalCompiler=pcFPC) and (CompilerMode in [cmFPC,cmOBJFPC])
  and ((FInitValues.IsDefined(NestedCompilerDefine))
    or (CompareFileExt(MainFilename,'pp',false)=0))
  then
    FNestedComments:=true;
    
  //DebugLn(Values.AsString);
  //DebugLn('TLinkScanner.Scan E --------');
  FMacrosOn:=(Values.Variables['MACROS']<>'0');
  if Src='' then exit;
  // beging scanning
  InitKeyWordList;
  AddLink(1,SrcPos,Code);
  LastTokenType:=lsttNone;
  LastProgressPos:=0;
  CheckForAbort:=Assigned(OnProgress);
  {$IFDEF CTDEBUG}
  DebugLn('TLinkScanner.Scan F ',dbgs(SrcLen));
  {$ENDIF}
  try
    try
      repeat
        // check every 10.000 bytes for abort
        if CheckForAbort and ((LastProgressPos-LastCleanSrcPos)>10000) then begin
          LastProgressPos:=LastCleanSrcPos;
          DoCheckAbort;
        end;
        ReadNextToken;
        //DebugLn('TLinkScanner.Scan G "',copy(Src,TokenStart,SrcPos-TokenStart),'"');
        if (TokenType=lsttEndOfInterface) and (LastTokenType<>lsttEqual) then
        begin
          EndOfInterfaceFound:=true;
          if ScanTillInterfaceEnd then break;
        end else if (LastTokenType=lsttEnd) and (TokenType=lsttPoint) then begin
          EndOfInterfaceFound:=true;
          EndOfSourceFound:=true;
          break;
        end else if SrcPos>SrcLen then
          break;
        LastTokenType:=TokenType;
      until false;
    finally
      if not FSkippingTillEndif then begin
        {$IFDEF ShowUpdateCleanedSrc}
        DebugLn('TLinkScanner.Scan UpdatePos=',DbgS(SrcPos-1));
        {$ENDIF}
        UpdateCleanedSource(SrcPos-1);
      end;
    end;
    IncreaseChangeStep;
    FForceUpdateNeeded:=false;
    FLastCleanedSrcLen:=CleanedLen;
  except
    on E: ELinkScannerError do begin
      if (not IgnoreErrorAfterValid)
      or (not IgnoreErrAfterPositionIsInFrontOfLastErrMessage) then
        raise;
      {$IFDEF ShowIgnoreErrorAfter}
      DebugLn('TLinkScanner.Scan IGNORING ERROR: ',LastErrorMessage);
      {$ENDIF}
    end;
  end;
  {$IFDEF CTDEBUG}
  DebugLn('TLinkScanner.Scan END ',dbgs(CleanedLen));
  {$ENDIF}
end;

procedure TLinkScanner.SetLinks(Index: integer; const Value: TSourceLink);
begin
  FLinks[Index]:=Value;
end;

procedure TLinkScanner.SkipComment;
// a normal pascal {} comment
begin
  CommentStyle:=CommentTP;
  CommentStartPos:=SrcPos;
  IncCommentLevel;
  inc(SrcPos);
  CommentInnerStartPos:=SrcPos;
  { HandleSwitches can dec CommentLevel }
  while (SrcPos<=SrcLen) and (CommentLevel>0) do begin
    case Src[SrcPos] of
      '{' : IncCommentLevel;
      '}' : DecCommentLevel;
    end;
    inc(SrcPos);
  end;
  CommentEndPos:=SrcPos;
  CommentInnerEndPos:=SrcPos-1;
  if (CommentLevel>0) then CommentEndNotFound;
  { handle compiler switches }
  if Src[CommentInnerStartPos]='$' then HandleDirectives;
  EndComment;
end;

procedure TLinkScanner.SkipDelphiComment;
// a  // newline  comment
begin
  CommentStyle:=CommentDelphi;
  CommentStartPos:=SrcPos;
  IncCommentLevel;
  inc(SrcPos,2);
  CommentInnerStartPos:=SrcPos;
  while (SrcPos<=SrcLen) and (Src[SrcPos]<>#10) do inc(SrcPos);
  DecCommentLevel;
  inc(SrcPos);
  CommentEndPos:=SrcPos;
  CommentInnerEndPos:=SrcPos-1;
  { handle compiler switches (ignore) }
  EndComment;
end;

procedure TLinkScanner.SkipOldTPComment;
// a (* *) comment
begin
  CommentStyle:=CommentDelphi;
  CommentStartPos:=SrcPos;
  IncCommentLevel;
  inc(SrcPos,2);
  CommentInnerStartPos:=SrcPos;
  // ToDo: nested comments
  while (SrcPos<SrcLen) do begin
    if ((Src[SrcPos]<>'*') or (Src[SrcPos+1]<>')')) then
      inc(SrcPos)
    else begin
      DecCommentLevel;
      inc(SrcPos,2);
      break;
    end;
  end;
  CommentEndPos:=SrcPos;
  CommentInnerEndPos:=SrcPos-2;
  if (CommentLevel>0) then CommentEndNotFound;
  { handle compiler switches }
  if Src[CommentInnerStartPos]='$' then HandleDirectives;
  EndComment;
end;

procedure TLinkScanner.CommentEndNotFound;
begin
  SrcPos:=CommentStartPos;
  RaiseException(ctsCommentEndNotFound);
end;

procedure TLinkScanner.UpdateCleanedSource(SourcePos: integer);
// add new parsed code to cleaned source string
var AddLen, i: integer;
begin
  if SourcePos=LastCleanSrcPos then exit;
  if SourcePos>SrcLen then SourcePos:=SrcLen;
  AddLen:=SourcePos-LastCleanSrcPos;
  if AddLen>length(FCleanedSrc)-CleanedLen then begin
    // expand cleaned source string by at least OldLen+1024
    i:=length(FCleanedSrc)+1024;
    if AddLen<i then AddLen:=i;
    SetLength(FCleanedSrc,length(FCleanedSrc)+AddLen);
  end;
  for i:=LastCleanSrcPos+1 to SourcePos do begin
    inc(CleanedLen);
    FCleanedSrc[CleanedLen]:=Src[i];
  end;
  {$IFDEF ShowUpdateCleanedSrc}
  DebugLn('TLinkScanner.UpdateCleanedSource A ',
    DbgS(LastCleanSrcPos),'-',DbgS(SourcePos),'="',
    StringToPascalConst(copy(Src,LastCleanSrcPos+1,20)),
    '".."',StringToPascalConst(copy(Src,SourcePos-19,20)),'"');
  {$ENDIF}
  LastCleanSrcPos:=SourcePos;
end;

procedure TLinkScanner.AddSourceChangeStep(ACode: pointer;AChangeStep: integer);

  procedure RaiseCodeNil;
  begin
    RaiseException('TLinkScanner.AddSourceChangeStep ACode=nil');
  end;

var l,r,m: integer;
  NewSrcChangeStep: PSourceChangeStep;
  c: pointer;
begin
  //DebugLn('[TLinkScanner.AddSourceChangeStep] ',DbgS(ACode));
  if ACode=nil then
    RaiseCodeNil;
  l:=0;
  r:=FSourceChangeSteps.Count-1;
  m:=0;
  c:=nil;
  while (l<=r) do begin
    m:=(l+r) shr 1;
    c:=PSourceChangeStep(FSourceChangeSteps[m])^.Code;
    if c<ACode then l:=m+1
    else if c>ACode then r:=m-1
    else exit;
  end;
  NewSrcChangeStep:=PSourceChangeStepMemManager.NewPSourceChangeStep;
  NewSrcChangeStep^.Code:=ACode;
  NewSrcChangeStep^.ChangeStep:=AChangeStep;
  if (FSourceChangeSteps.Count>0) and (c<ACode) then inc(m);
  FSourceChangeSteps.Insert(m,NewSrcChangeStep);
  //DebugLn('   ADDING ',DbgS(ACode),',',FSourceChangeSteps.Count);
end;

function TLinkScanner.TokenIs(const AToken: shortstring): boolean;
var ATokenLen: integer;
  i: integer;
begin
  Result:=false;
  if (SrcPos<=SrcLen+1) and (TokenStart>=1) then begin
    ATokenLen:=length(AToken);
    if ATokenLen=SrcPos-TokenStart then begin
      for i:=1 to ATokenLen do
        if AToken[i]<>Src[TokenStart-1+i] then exit;
      Result:=true;
    end;
  end;
end;

function TLinkScanner.UpTokenIs(const AToken: shortstring): boolean;
var ATokenLen: integer;
  i: integer;
begin
  Result:=false;
  if (SrcPos<=SrcLen+1) and (TokenStart>=1) then begin
    ATokenLen:=length(AToken);
    if ATokenLen=SrcPos-TokenStart then begin
      for i:=1 to ATokenLen do
        if AToken[i]<>UpChars[Src[TokenStart-1+i]] then exit;
      Result:=true;
    end;
  end;
end;

function TLinkScanner.ConsistencyCheck: integer;
var i: integer;
begin
  if (FLinks=nil) xor (FLinkCapacity=0) then begin
    Result:=-1; exit;
  end;
  if FLinks<>nil then begin
    for i:=0 to FLinkCount-1 do begin
      if FLinks[i].Code=nil then begin
        Result:=-2;  exit;
      end;
      if (FLinks[i].CleanedPos<1) or (FLinks[i].CleanedPos>SrcLen) then begin
        Result:=-3;  exit;
      end;
    end;
  end;
  if SrcLen<>length(Src) then begin // length of current source
    Result:=-4;  exit;
  end;
  if Values<>nil then begin
    Result:=Values.ConsistencyCheck;
    if Result<>0 then begin
      dec(Result,10);  exit;
    end;
  end;
  Result:=0;
end;

procedure TLinkScanner.WriteDebugReport;
var i: integer;
begin
  // header
  DebugLn('');
  DebugLn('[TLinkScanner.WriteDebugReport]',
     ' ChangeStepCount=',dbgs(FSourceChangeSteps.Count),
     ' LinkCount=',dbgs(LinkCount),
     ' CleanedLen=',dbgs(CleanedLen));
  // time stamps
  for i:=0 to FSourceChangeSteps.Count-1 do begin
    DebugLn('  ChangeStep ',dbgs(i),': '
        ,' Code=',dbgs(PSourceChangeStep(FSourceChangeSteps[i])^.Code)
        ,' ChangeStep=',dbgs(PSourceChangeStep(FSourceChangeSteps[i])^.ChangeStep));
  end;
  // links
  for i:=0 to LinkCount-1 do begin
    DebugLn('  Link ',dbgs(i),':'
        ,' CleanedPos=',dbgs(FLinks[i].CleanedPos)
        ,' SrcPos=',dbgs(FLinks[i].SrcPos)
        ,' Code=',dbgs(FLinks[i].Code)
      );
  end;
end;

function TLinkScanner.UpdateNeeded(
  OnlyInterfaceNeeded, CheckFilesOnDisk: boolean): boolean;
{ the clean source must be rebuild if
   1. scanrange changed from only interface to whole source
   2. unit source changed
   3. one of its include files changed
   4. init values changed (e.g. initial compiler defines)
}
var i: integer;
  SrcLog: TSourceLog;
  NewInitValues: TExpressionEvaluator;
  GlobalWriteLockIsSet: boolean;
  GlobalWriteLockStep: integer;
  NewInitValuesChangeStep: integer;
begin
  Result:=true;
  if FForceUpdateNeeded then exit;
  
  // do a quick test: check the GlobalWriteLockStep
  if Assigned(OnGetGlobalWriteLockInfo) then begin
    OnGetGlobalWriteLockInfo(GlobalWriteLockIsSet,GlobalWriteLockStep);
    if GlobalWriteLockIsSet then begin
      // The global write lock is set. That means, input variables and code are
      // frozen
      if (FLastGlobalWriteLockStep=GlobalWriteLockStep) then begin
        // source and values did not change since last UpdateNeeded check
        // -> check only if ScanRange has increased
        if (OnlyInterfaceNeeded=false) and (not EndOfSourceFound) then exit;
        Result:=false;
        exit;
      end else begin
        // this is the first check in this GlobalWriteLockStep
        FLastGlobalWriteLockStep:=GlobalWriteLockStep;
        // proceed normally ...
      end;
    end;
  end;
  
  // check if any input has changed ...
  FForceUpdateNeeded:=true;
  
  // check if code was ever scanned
  if LinkCount=0 then exit;
  
  // check if ScanRange has increased
  if (OnlyInterfaceNeeded=false) and (ScanTillInterfaceEnd) then exit;
  
  // check all used files
  if Assigned(FOnGetSource) then begin
    if CheckFilesOnDisk and Assigned(FOnCheckFileOnDisk) then begin
      // if files changed on disk, reload them
      for i:=0 to FSourceChangeSteps.Count-1 do begin
        SrcLog:=FOnGetSource(Self,
                             PSourceChangeStep(FSourceChangeSteps[i])^.Code);
        FOnCheckFileOnDisk(SrcLog);
      end;
    end;
    for i:=0 to FSourceChangeSteps.Count-1 do begin
      SrcLog:=FOnGetSource(Self,PSourceChangeStep(FSourceChangeSteps[i])^.Code);
      if PSourceChangeStep(FSourceChangeSteps[i])^.ChangeStep<>SrcLog.ChangeStep
      then exit;
    end;
  end;
  
  // check initvalues
  if Assigned(FOnGetInitValues) then begin
    if FInitValues=nil then exit;
    NewInitValues:=FOnGetInitValues(Code,NewInitValuesChangeStep);
    if (NewInitValues<>nil)
    and (NewInitValuesChangeStep<>FInitValuesChangeStep)
    and (not FInitValues.Equals(NewInitValues)) then
      exit;
  end;
  
  // check missing include files
  if MissingIncludeFilesNeedsUpdate then exit;
  
  // no update needed :)
  FForceUpdateNeeded:=false;
  //DebugLn('TLinkScanner.UpdateNeeded END');
  Result:=false;
end;

procedure TLinkScanner.SetIgnoreErrorAfter(ACursorPos: integer; ACode: Pointer
  );
begin
  if (FIgnoreErrorAfterCode=ACode)
  and (FIgnoreErrorAfterCursorPos=ACursorPos) then exit;
  FIgnoreErrorAfterCode:=ACode;
  FIgnoreErrorAfterCursorPos:=ACursorPos;
  LastErrorCheckedForIgnored:=false;
  {$IFDEF ShowIgnoreErrorAfter}
  DbgOut('TLinkScanner.SetIgnoreErrorAfter ');
  if FIgnoreErrorAfterCode<>nil then
    DbgOut(OnGetFileName(Self,FIgnoreErrorAfterCode))
  else
    DbgOut('nil');
  DbgOut(' ',dbgs(FIgnoreErrorAfterCursorPos));
  DebugLn('');
  {$ENDIF}
end;

procedure TLinkScanner.ClearIgnoreErrorAfter;
begin
  SetIgnoreErrorAfter(0,nil);
end;

function TLinkScanner.IgnoreErrAfterPositionIsInFrontOfLastErrMessage: boolean;
var
  CleanResult: integer;
begin
  //DebugLn('TLinkScanner.IgnoreErrAfterPositionIsInFrontOfLastErrMessage');
  //DebugLn('  LastErrorCheckedForIgnored=',LastErrorCheckedForIgnored,
  //  ' LastErrorBehindIgnorePosition=',LastErrorBehindIgnorePosition);
  if LastErrorCheckedForIgnored then
    Result:=LastErrorBehindIgnorePosition
  else begin
    CleanedIgnoreErrorAfterPosition:=-1;
    if (FIgnoreErrorAfterCode<>nil) and (FIgnoreErrorAfterCursorPos>0) then
    begin
      CleanResult:=CursorToCleanPos(FIgnoreErrorAfterCursorPos,
                         FIgnoreErrorAfterCode,CleanedIgnoreErrorAfterPosition);
      //DebugLn('  CleanResult=',CleanResult,
      //  ' CleanedIgnoreErrorAfterPosition=',CleanedIgnoreErrorAfterPosition,
      //  ' FIgnoreErrorAfterCursorPos=',FIgnoreErrorAfterCursorPos);
      if (CleanResult=0) or (CleanResult=-1)
      or (not LastErrorIsValid) then begin
        Result:=true;
      end else begin
        Result:=false;
      end;
    end else begin
      Result:=false;
    end;
    LastErrorBehindIgnorePosition:=Result;
    LastErrorCheckedForIgnored:=true;
  end;
  {$IFDEF ShowIgnoreErrorAfter}
  DebugLn('TLinkScanner.IgnoreErrAfterPositionIsInFrontOfLastErrMessage Result=',dbgs(Result));
  {$ENDIF}
end;

function TLinkScanner.IgnoreErrorAfterCleanedPos: integer;
begin
  if IgnoreErrAfterPositionIsInFrontOfLastErrMessage then
    Result:=CleanedIgnoreErrorAfterPosition
  else
    Result:=-1;
  {$IFDEF ShowIgnoreErrorAfter}
  DebugLn('TLinkScanner.IgnoreErrorAfterCleanedPos Result=',dbgs(Result));
  {$ENDIF}
end;

function TLinkScanner.IgnoreErrorAfterValid: boolean;
begin
  Result:=(FIgnoreErrorAfterCode<>nil);
  {$IFDEF ShowIgnoreErrorAfter}
  DebugLn('TLinkScanner.IgnoreErrorAfterValid Result=',dbgs(Result));
  {$ENDIF}
end;

function TLinkScanner.LastErrorsInFrontOfCleanedPos(ACleanedPos: integer
  ): boolean;
begin
  Result:=LastErrorIsValid and (CleanedLen>ACleanedPos);
  {$IFDEF ShowIgnoreErrorAfter}
  DebugLn('TLinkScanner.LastErrorsInFrontOfCleanedPos Result=',dbgs(Result));
  {$ENDIF}
end;

procedure TLinkScanner.RaiseLastErrorIfInFrontOfCleanedPos(ACleanedPos: integer
  );
begin
  if LastErrorsInFrontOfCleanedPos(ACleanedPos) then
    RaiseLastError;
end;

{-------------------------------------------------------------------------------
  function TLinkScanner.GuessMisplacedIfdefEndif
  Params: StartCursorPos: integer; StartCode: pointer;
          var EndCursorPos: integer; var EndCode: Pointer;
  Result: boolean;


-------------------------------------------------------------------------------}
function TLinkScanner.GuessMisplacedIfdefEndif(StartCursorPos: integer;
  StartCode: pointer;
  var EndCursorPos: integer; var EndCode: Pointer): boolean;
  
  type
    TIf = record
      StartPos: integer; // comment start e.g. {
      EndPos: integer;   // comment end  e.g. the char behind }
      Expression: string;
      HasElse: boolean;
    end;
    PIf = ^TIf;
    
    TTokenType = (ttNone,
                  ttCommentStart, ttCommentEnd, // '{' '}'
                  ttTPCommentStart, ttTPCommentEnd, // '(*' '*)'
                  ttDelphiCommentStart, // '//'
                  ttLineEnd
                  );
                  
    TTokenRange = (trCode, trComment, trTPComment, trDelphiComment);

    TToken = record
      StartPos: integer;
      EndPos: integer;
      TheType: TTokenType;
      Range: TTokenRange;
      NestedComments: boolean;
    end;
    
    TDirectiveType = (dtUnknown, dtIf, dtIfDef, dtIfNDef, dtIfOpt,
                      dtElse, dtEndif);
    
  function FindNextToken(const ASrc: string; var AToken: TToken): boolean;
  var
    ASrcLen: integer;
    OldRange: TTokenRange;
  begin
    Result:=true;
    AToken.StartPos:=AToken.EndPos;
    ASrcLen:=length(ASrc);
    OldRange:=AToken.Range;
    
    while (AToken.StartPos<=ASrcLen) do begin
      case ASrc[AToken.StartPos] of
      '{': // pascal comment start
        begin
          AToken.EndPos:=AToken.StartPos+1;
          AToken.TheType:=ttCommentStart;
          AToken.Range:=trComment;
          if (OldRange=trCode) then
            exit
          else if AToken.NestedComments then begin
            if (not FindNextToken(ASrc,AToken)) then begin
              Result:=false;
              exit;
            end;
            AToken.StartPos:=AToken.EndPos-1;
            AToken.Range:=OldRange;
          end;
        end;
        
      '(': // check if Turbo Pascal comment start
        if (AToken.StartPos<ASrcLen) and (ASrc[AToken.StartPos+1]='*') then
        begin
          AToken.EndPos:=AToken.StartPos+2;
          AToken.TheType:=ttTPCommentStart;
          AToken.Range:=trTPComment;
          if (OldRange=trCode) then
            exit
          else if AToken.NestedComments then begin
            if (not FindNextToken(ASrc,AToken)) then begin
              Result:=false;
              exit;
            end;
            AToken.StartPos:=AToken.EndPos-1;
            AToken.Range:=OldRange;
          end;
        end;
        
      '/': // check if Delphi comment start
        if (AToken.StartPos<ASrcLen) and (ASrc[AToken.StartPos+1]='/') then
        begin
          AToken.EndPos:=AToken.StartPos+2;
          AToken.TheType:=ttDelphiCommentStart;
          AToken.Range:=trDelphiComment;
          if (OldRange=trCode) then
            exit
          else if AToken.NestedComments then begin
            if (not FindNextToken(ASrc,AToken)) then begin
              Result:=false;
              exit;
            end;
            AToken.StartPos:=AToken.EndPos-1;
            AToken.Range:=OldRange;
          end;
        end;
        
      '}': // pascal comment end
        case AToken.Range of
        trComment:
          begin
            AToken.EndPos:=AToken.StartPos+1;
            AToken.TheType:=ttCommentEnd;
            AToken.Range:=trCode;
            exit;
          end;
          
        trCode:
          begin
            // error (comment was never openend)
            // -> skip rest of code
            AToken.StartPos:=ASrcLen;
          end;

        else
          // in different kind of comment -> ignore
        end;
        
      '*': // turbo pascal comment end
        if (AToken.StartPos<ASrcLen) and (ASrc[AToken.StartPos+1]=')') then
        begin
          case AToken.Range of
          trTPComment:
            begin
              AToken.EndPos:=AToken.StartPos+1;
              AToken.TheType:=ttTPCommentEnd;
              AToken.Range:=trCode;
              exit;
            end;

          trCode:
            begin
              // error (comment was never openend)
              // -> skip rest of code
              AToken.StartPos:=ASrcLen;
            end;

          else
            // in different kind of comment -> ignore
          end;
        end;

      #10,#13: // line end
        if AToken.Range in [trDelphiComment] then begin
          AToken.EndPos:=AToken.StartPos+1;
          if (AToken.StartPos<ASrcLen)
          and (ASrc[AToken.StartPos+1] in [#10,#13])
          and (ASrc[AToken.StartPos+1]<>ASrc[AToken.StartPos]) then
            inc(AToken.EndPos);
          AToken.TheType:=ttLineEnd;
          AToken.Range:=trCode;
          exit;
        end else begin
          // in different kind of comment -> ignore
        end;

      '''': // skip string constant
        begin
          inc(AToken.StartPos);
          while (AToken.StartPos<=ASrcLen) do begin
            if (not (ASrc[AToken.StartPos] in ['''',#10,#13])) then begin
              inc(AToken.StartPos);
            end else begin
              break;
            end;
          end;
        end;
        
      end;
      inc(AToken.StartPos);
    end;
    
    // at the end of the code
    AToken.EndPos:=AToken.StartPos;
    AToken.TheType:=ttNone;
    Result:=false;
  end;

  procedure FreeIfStack(var IfStack: TFPList);
  var
    i: integer;
    AnIf: PIf;
  begin
    if IfStack=nil then exit;
    for i:=0 to IfStack.Count-1 do begin
      AnIf:=PIf(IfStack[i]);
      AnIf^.Expression:='';
      Dispose(AnIf);
    end;
    IfStack.Free;
    IfStack:=nil;
  end;
  
  function InitGuessMisplaced(var CurToken: TToken; ACode: Pointer;
    var ASrc: string; var ASrcLen: integer): boolean;
  var
    ASrcLog: TSourceLog;
  begin
    Result:=false;
    
    // get source
    if (FOnGetSource=nil) then exit;
    ASrcLog:=FOnGetSource(Self,ACode);
    if ASrcLog=nil then exit;
    ASrc:=ASrcLog.Source;
    ASrcLen:=length(ASrc);

    CurToken.StartPos:=1;
    CurToken.EndPos:=1;
    CurToken.Range:=trCode;
    CurToken.TheType:=ttNone;
    CurToken.NestedComments:=NestedComments;
    Result:=true;
  end;
  
  function ReadDirectiveType(const ASrc: string;
    AToken: TToken): TDirectiveType;
  const
    DIR_RST: array[0..5] of TDirectiveType = (
      dtIfDef, dtIfNDef, dtIfOpt, dtIf, dtElse, dtEndif
    );
    DIR_TXT: array[0..5] of PChar = (
      'IFDEF', 'IFNDEF', 'IFOPT', 'IF', 'ELSE', 'ENDIF'
    );
  var
    ASrcLen, p: integer;
    n: Integer;
  begin
    Result:=dtUnknown;
    ASrcLen:=length(ASrc);
    p:=AToken.EndPos;
    if (p<ASrcLen) and (ASrc[p]='$') then
    begin
      // compiler directive
      inc(p);
      for n := Low(DIR_TXT) to High(DIR_TXT) do
      begin
        if CompareIdentifiers(@ASrc[p], DIR_TXT[n]) = 0
        then begin
          Result := DIR_RST[n];
          Exit;
        end;
      end;
    end;
  end;
  
  procedure PushIfOnStack(const ASrc: string; AToken: TToken; IfStack: TFPList);
  var
    NewIf: PIf;
  begin
    New(NewIf);
    FillChar(NewIf^,SizeOf(PIf),0);
    NewIf^.StartPos:=AToken.StartPos;
    FindNextToken(ASrc,AToken);
    NewIf^.EndPos:=AToken.EndPos;
    NewIf^.Expression:=copy(ASrc,NewIf^.StartPos+1,
                            AToken.EndPos-NewIf^.StartPos-1);
    NewIf^.HasElse:=false;
    IfStack.Add(NewIf);
  end;
  
  procedure PopIfFromStack(IfStack: TFPList);
  var Topif: PIf;
  begin
    TopIf:=PIf(IfStack[IfStack.Count-1]);
    Dispose(TopIf);
    IfStack.Delete(IfStack.Count-1);
  end;

  function GuessMisplacedIfdefEndifInCode(ACode: Pointer;
    StartCursorPos: integer; StartCode: Pointer;
    var EndCursorPos: integer; var EndCode: Pointer): boolean;
  var
    ASrc: string;
    ASrcLen: integer;
    CurToken: TToken;
    IfStack: TFPList;
    DirectiveType: TDirectiveType;
  begin
    Result:=false;
    if not InitGuessMisplaced(CurToken,ACode,ASrc,ASrcLen) then exit;

    IfStack:=TFPList.Create;
    try
      repeat
        if (not FindNextToken(ASrc,CurToken)) then begin
          exit;
        end;
        if CurToken.Range in [trComment] then begin
          DirectiveType:=ReadDirectiveType(ASrc,CurToken);

          case DirectiveType of

          dtIf, dtIfDef, dtIfNDef, dtIfOpt:
            PushIfOnStack(ASrc,CurToken,IfStack);

          dtElse:
            begin
              if (IfStack.Count=0) or (PIf(IfStack[IfStack.Count-1])^.HasElse)
              then begin
                // this $ELSE has no $IF
                // -> misplaced directive found
                EndCursorPos:=CurToken.EndPos;
                EndCode:=ACode;
                DebugLn('GuessMisplacedIfdefEndif  $ELSE has no $IF');
                Result:=true;
                exit;
              end;
              PIf(IfStack[IfStack.Count-1])^.HasElse:=true;
            end;
            
          dtEndif:
            begin
              if (IfStack.Count=0) then begin
                // this $ENDIF has no $IF
                // -> misplaced directive found
                EndCursorPos:=CurToken.EndPos;
                EndCode:=ACode;
                DebugLn('GuessMisplacedIfdefEndif  $ENDIF has no $IF');
                Result:=true;
                exit;
              end;
              PopIfFromStack(IfStack);
            end;

          end;
        end;
      until CurToken.TheType=ttNone;
      if IfStack.Count>0 then begin
        // there is an $IF without $ENDIF
        // -> misplaced directive found
        EndCursorPos:=PIf(IfStack[IfStack.Count-1])^.StartPos+1;
        EndCode:=ACode;
        DebugLn('GuessMisplacedIfdefEndif  $IF without $ENDIF');
        Result:=true;
        exit;
      end;
    finally
      FreeIfStack(IfStack);
    end;
  end;
        
var
  LinkID, i, BestSrcPos: integer;
  LastCode: Pointer;
  SearchedCodes: TFPList;
begin
  Result:=false;
  
  // search link before start position
  LinkID:=-1;
  BestSrcPos:=0;
  i:=0;
  while i<LinkCount do begin
    if (StartCode=FLinks[i].Code) and (StartCursorPos>=FLinks[i].SrcPos) then begin
      if (LinkID<0) or (BestSrcPos<FLinks[i].SrcPos) then
        LinkID:=i;
    end;
    inc(i);
  end;
  if LinkID<0 then exit;
  
  // go through all following sources and guess misplaced ifdef/endif
  SearchedCodes:=TFPList.Create;
  try
    while LinkId<LinkCount do begin
      Result:=GuessMisplacedIfdefEndifInCode(FLinks[LinkID].Code,
        StartCursorPos,StartCode,EndCursorPos,EndCode);
      if Result then exit;
      // search next code
      LastCode:=FLinks[LinkID].Code;
      SearchedCodes.Add(LastCode);
      repeat
        inc(LinkID);
        if LinkID>=LinkCount then exit;
      until (FLinks[LinkID].Code<>LastCode)
      and (SearchedCodes.IndexOf(FLinks[LinkID].Code)<0);
    end;
  finally
    SearchedCodes.Free;
  end;
end;

procedure TLinkScanner.SetMainCode(const Value: pointer);
begin
  if FMainCode=Value then exit;
  FMainCode:=Value;
  FMainSourceFilename:=FOnGetFileName(Self,FMainCode);
  Clear;
end;

procedure TLinkScanner.SetScanTillInterfaceEnd(const Value: boolean);
begin
  if FScanTillInterfaceEnd=Value then exit;
  FScanTillInterfaceEnd := Value;
  if not Value then Clear;
end;

function TLinkScanner.ShortSwitchDirective: boolean;
begin
  FDirectiveName:=CompilerSwitchesNames[FDirectiveName[1]];
  if FDirectiveName<>'' then begin
    if (SrcPos<=SrcLen) and (Src[SrcPos] in ['-','+']) then begin
      if Src[SrcPos]='-' then
        Values.Variables[FDirectiveName]:='0'
      else
        Values.Variables[FDirectiveName]:='1';
      Result:=ReadNextSwitchDirective;
    end else begin
      if FDirectiveName<>CompilerSwitchesNames['I'] then
        Result:=LongSwitchDirective
      else
        Result:=IncludeDirective;
    end;
  end else
    Result:=true;
end;

procedure TLinkScanner.BuildDirectiveFuncList;
var c: char;
begin
  FDirectiveFuncList:=TKeyWordFunctionList.Create;
  with FDirectiveFuncList do begin
    for c:='A' to 'Z' do begin
      if CompilerSwitchesNames[c]<>'' then begin
        Add(c,{$ifdef FPC}@{$endif}ShortSwitchDirective);
        Add(CompilerSwitchesNames[c],{$ifdef FPC}@{$endif}LongSwitchDirective);
      end;
    end;
    Add('IFDEF',{$ifdef FPC}@{$endif}IfdefDirective);
    Add('IFNDEF',{$ifdef FPC}@{$endif}IfndefDirective);
    Add('IF',{$ifdef FPC}@{$endif}IfDirective);
    Add('IFOPT',{$ifdef FPC}@{$endif}IfOptDirective);
    Add('ENDIF',{$ifdef FPC}@{$endif}EndIfDirective);
    Add('ELSE',{$ifdef FPC}@{$endif}ElseDirective);
    Add('ELSEIF',{$ifdef FPC}@{$endif}ElseIfDirective);
    Add('IFEND',{$ifdef FPC}@{$endif}IfEndDirective);
    Add('DEFINE',{$ifdef FPC}@{$endif}DefineDirective);
    Add('UNDEF',{$ifdef FPC}@{$endif}UndefDirective);
    Add('INCLUDE',{$ifdef FPC}@{$endif}IncludeDirective);
    Add('INCLUDEPATH',{$ifdef FPC}@{$endif}IncludePathDirective);
    Add('MODE',{$ifdef FPC}@{$endif}ModeDirective);
    Add('THREADING',{$ifdef FPC}@{$endif}ThreadingDirective);
  end;
  FSkipDirectiveFuncList:=TKeyWordFunctionList.Create;
  with FSkipDirectiveFuncList do begin
    Add('IFDEF',{$ifdef FPC}@{$endif}SkipIfDirective);
    Add('IFNDEF',{$ifdef FPC}@{$endif}SkipIfDirective);
    Add('IF',{$ifdef FPC}@{$endif}SkipIfDirective);
    Add('IFOPT',{$ifdef FPC}@{$endif}SkipIfDirective);
    Add('ENDIF',{$ifdef FPC}@{$endif}EndIfDirective);
    Add('ELSE',{$ifdef FPC}@{$endif}ElseDirective);
    Add('ELSEIF',{$ifdef FPC}@{$endif}ElseIfDirective);
    Add('IFEND',{$ifdef FPC}@{$endif}IfEndDirective);
  end;
end;

function TLinkScanner.LongSwitchDirective: boolean;
var ValStart: integer;
begin
  SkipSpace;
  ValStart:=SrcPos;
  while (SrcPos<=SrcLen) and IsWordChar[Src[SrcPos]] do
    inc(SrcPos);
  if CompareUpToken('ON',Src,ValStart,SrcPos) then
    Values.Variables[FDirectiveName]:='1'
  else if CompareUpToken('OFF',Src,ValStart,SrcPos) then
    Values.Variables[FDirectiveName]:='0'
  else if CompareUpToken('PRELOAD',Src,ValStart,SrcPos)
  and (FDirectiveName='ASSERTIONS') then
    Values.Variables[FDirectiveName]:='PRELOAD'
  else if (FDirectiveName='LOCALSYMBOLS') then
    // ignore link object directive
  else if (FDirectiveName='RANGECHECKS') then
    // ignore link object directive
  else if (FDirectiveName='ALIGN') then
    // set record align size
  else begin
    RaiseExceptionFmt(ctsInvalidFlagValueForDirective,
        [copy(Src,ValStart,SrcPos-ValStart),FDirectiveName]);
  end;
  Result:=ReadNextSwitchDirective;
end;

function TLinkScanner.ModeDirective: boolean;
// $MODE DEFAULT, OBJFPC, TP, FPC, GPC, DELPHI
var ValStart: integer;
  AMode: TCompilerMode;
  ModeValid: boolean;
begin
  SkipSpace;
  ValStart:=SrcPos;
  while (SrcPos<=SrcLen) and (IsWordChar[Src[SrcPos]]) do
    inc(SrcPos);
  // undefine all mode macros
  for AMode:=Low(TCompilerMode) to High(TCompilerMode) do
    Values.Undefine(CompilerModeVars[AMode]);
  CompilerMode:=cmFPC;
  // define new mode macro
  if CompareUpToken('DEFAULT',Src,ValStart,SrcPos) then begin
    // set mode to initial mode
    for AMode:=Low(TCompilerMode) to High(TCompilerMode) do
      if FInitValues.IsDefined(CompilerModeVars[AMode]) then begin
        CompilerMode:=AMode;
      end;
  end else begin
    ModeValid:=false;
    for AMode:=Low(TCompilerMode) to High(TCompilerMode) do
      if CompareUpToken(CompilerModeNames[AMode],Src,ValStart,SrcPos) then
      begin
        CompilerMode:=AMode;
        Values.Variables[CompilerModeVars[AMode]]:='1';
        ModeValid:=true;
        break;
      end;
    if not ModeValid then
      RaiseExceptionFmt(ctsInvalidMode,[copy(Src,ValStart,SrcPos-ValStart)]);
  end;
  Result:=true;
end;

function TLinkScanner.ThreadingDirective: boolean;
var
  ValStart: integer;
begin
  SkipSpace;
  ValStart:=SrcPos;
  while (SrcPos<=SrcLen) and (IsWordChar[Src[SrcPos]]) do
    inc(SrcPos);
  if CompareUpToken('ON',Src,ValStart,SrcPos) then begin
    // define THREADING
    Values.Variables[ExternalMacroStart+'UseSysThrds']:='1';
  end else begin
    // undefine THREADING
    Values.Undefine(ExternalMacroStart+'UseSysThrds');
  end;
  Result:=true;
end;

function TLinkScanner.ReadNextSwitchDirective: boolean;
var DirStart, DirLen: integer;
begin
  SkipSpace;
  if (SrcPos<=SrcLen) and (Src[SrcPos]=',') then begin
    inc(SrcPos);
    DirStart:=SrcPos;
    while (SrcPos<=SrcLen) and (IsIdentStartChar[Src[SrcPos]]) do
      inc(SrcPos);
    DirLen:=SrcPos-DirStart;
    if DirLen>255 then DirLen:=255;
    FDirectiveName:=UpperCaseStr(copy(Src,DirStart,DirLen));
    Result:=FDirectiveFuncList.DoIt(Src,DirStart,DirLen);
  end else
    Result:=true;
end;

function TLinkScanner.IfdefDirective: boolean;
// {$ifdef name comment}
var VariableName: string;
begin
  inc(IfLevel);
  SkipSpace;
  VariableName:=ReadUpperIdentifier;
  if (VariableName<>'') and (not Values.IsDefined(VariableName)) then
    SkipTillEndifElse;
  Result:=true;
end;

procedure TLinkScanner.SkipSpace;
begin
  while (SrcPos<=SrcLen) and (IsSpaceChar[Src[SrcPos]]) do inc(SrcPos);
end;

function TLinkScanner.ReadIdentifier: string;
var StartPos: integer;
begin
  StartPos:=SrcPos;
  if (SrcPos<=SrcLen) and (IsIdentStartChar[Src[SrcPos]]) then begin
    inc(SrcPos);
    while (SrcPos<=SrcLen) and (IsIdentChar[Src[SrcPos]]) do
      inc(SrcPos);
    Result:=copy(Src,StartPos,SrcPos-StartPos);
  end else
    Result:='';
end;

function TLinkScanner.ReadUpperIdentifier: string;
var StartPos: integer;
begin
  StartPos:=SrcPos;
  if (SrcPos<=SrcLen) and (IsIdentStartChar[Src[SrcPos]]) then begin
    inc(SrcPos);
    while (SrcPos<=SrcLen) and (IsIdentChar[Src[SrcPos]]) do
      inc(SrcPos);
    Result:=UpperCaseStr(copy(Src,StartPos,SrcPos-StartPos));
  end else
    Result:='';
end;

procedure TLinkScanner.EndComment;
begin
  CommentStyle:=CommentNone;
end;

function TLinkScanner.IfndefDirective: boolean;
// {$ifndef name comment}
var VariableName: string;
begin
  inc(IfLevel);
  SkipSpace;
  VariableName:=ReadUpperIdentifier;
  if (VariableName<>'') and (Values.IsDefined(VariableName)) then
    SkipTillEndifElse;
  Result:=true;
end;

function TLinkScanner.EndifDirective: boolean;
// {$endif comment}

  procedure RaiseAWithoutB;
  begin
    RaiseExceptionFmt(ctsAwithoutB,['$ENDIF','$IF'])
  end;
  
begin
  dec(IfLevel);
  if IfLevel<0 then
    RaiseAWithoutB
  else if IfLevel<FSkipIfLevel then begin
    FSkippingTillEndif:=false;
  end;
  Result:=true;
end;

function TLinkScanner.ElseDirective: boolean;
// {$else comment}

  procedure RaiseAWithoutB;
  begin
    RaiseExceptionFmt(ctsAwithoutB,['$ELSE','$IF']);
  end;

begin
  if IfLevel=0 then
    RaiseAWithoutB;
  if not FSkippingTillEndif then
    SkipTillEndifElse
  else if IfLevel=FSkipIfLevel then
    FSkippingTillEndif:=false;
  Result:=true;
end;

function TLinkScanner.ElseIfDirective: boolean;
// {$elseif expression}

  procedure RaiseAWithoutB;
  begin
    RaiseExceptionFmt(ctsAwithoutB,['$ELSEIF','$IF']);
  end;

begin
  if IfLevel=0 then
    RaiseAWithoutB;
  if not FSkippingTillEndif then begin
    SkipTillEndifElse;
    Result:=true;
  end else if IfLevel=FSkipIfLevel then
    Result:=IfDirective;
end;

function TLinkScanner.IfEndDirective: boolean;
// {$IfEnd comment}

  procedure RaiseAWithoutB;
  begin
    RaiseExceptionFmt(ctsAwithoutB,['$IfEnd','$ElseIf'])
  end;

begin
  dec(IfLevel);
  if IfLevel<0 then
    RaiseAWithoutB
  else if IfLevel<FSkipIfLevel then begin
    FSkippingTillEndif:=false;
  end;
  Result:=true;
end;

function TLinkScanner.DefineDirective: boolean;
// {$define name} or {$define name:=value}
var VariableName: string;
begin
  SkipSpace;
  VariableName:=ReadUpperIdentifier;
  if (VariableName<>'') then begin
    if FMacrosOn and (SrcPos<SrcLen) and (Src[SrcPos]=':') and (Src[SrcPos]='=')
    then begin
      inc(SrcPos,2);
      Values.Variables[VariableName]:=
        copy(Src,SrcPos,CommentInnerEndPos-SrcPos);
    end else begin
      Values.Variables[VariableName]:='1';
    end;
  end;
  Result:=true;
end;

function TLinkScanner.UndefDirective: boolean;
// {$undefine name}
var VariableName: string;
begin
  SkipSpace;
  VariableName:=ReadUpperIdentifier;
  if (VariableName<>'') then
    Values.Undefine(VariableName);
  Result:=true;
end;

function TLinkScanner.IncludeDirective: boolean;
// {$i filename} or {$include filename}
var IncFilename: string;
begin
  inc(SrcPos);
  if (Src[SrcPos]<>'%') then begin
    IncFilename:=Trim(copy(Src,SrcPos,CommentInnerEndPos-SrcPos));
    if PascalCompiler<>pcDelphi then begin
      // default is fpc behaviour (default extension is .pp)
      if ExtractFileExt(IncFilename)='' then
        IncFilename:=IncFilename+'.pp';
    end else begin
      // delphi understands quoted include files and default extension is .pas
      if (copy(IncFilename,1,1)='''')
      and (copy(IncFilename,length(IncFilename),1)='''') then
        IncFilename:=copy(IncFilename,2,length(IncFilename)-2);
      if ExtractFileExt(IncFilename)='' then
        IncFilename:=IncFilename+'.pas';
    end;
    {$IFDEF ShowUpdateCleanedSrc}
    DebugLn('TLinkScanner.IncludeDirective A IncFilename=',IncFilename,' UpdatePos=',DbgS(CommentEndPos-1));
    {$ENDIF}
    UpdateCleanedSource(CommentEndPos-1);
    // put old position on stack
    PushIncludeLink(CleanedLen,CommentEndPos,Code);
    // load include file
    Result:=IncludeFile(IncFilename);
    if Result then begin
      if (SrcPos<=SrcLen) then
        CommentEndPos:=SrcPos
      else
        ReturnFromIncludeFile;
    end else begin
      PopIncludeLink;
    end;
  end;
  //DebugLn('[TLinkScanner.IncludeDirective] END ',CommentEndPos,',',SrcPos,',',SrcLen);
end;

function TLinkScanner.IncludePathDirective: boolean;
// {$includepath path_addition}
var AddPath, PathDivider: string;
begin
  inc(SrcPos);
  AddPath:=Trim(copy(Src,SrcPos,CommentInnerEndPos-SrcPos));
  PathDivider:=':';
  Values.Variables[ExternalMacroStart+'INCPATH']:=
    Values.Variables[ExternalMacroStart+'INCPATH']+PathDivider+AddPath;
  Result:=true;
end;

function TLinkScanner.LoadSourceCaseSensitive(
  const AFilename: string): pointer;
var
  Path, FileNameOnly: string;
  SecondaryFileNameOnly: String;
begin
  Path:=ExtractFilePath(AFilename);
  if (Path<>'') and (not FilenameIsAbsolute(Path)) then
    Path:=ExpandFilename(Path);
  FileNameOnly:=ExtractFilename(AFilename);
  Result:=nil;
  Result:=FOnLoadSource(Self,TrimFilename(Path+FileNameOnly),true);
  if (Result<>nil) then exit;
  SecondaryFileNameOnly:=lowercase(FileNameOnly);
  if (SecondaryFileNameOnly<>FileNameOnly) then begin
    Result:=FOnLoadSource(Self,TrimFilename(Path+SecondaryFileNameOnly),true);
    if (Result<>nil) then exit;
  end;
  SecondaryFileNameOnly:=UpperCaseStr(FileNameOnly);
  if (SecondaryFileNameOnly<>FileNameOnly) then begin
    Result:=FOnLoadSource(Self,TrimFilename(Path+SecondaryFileNameOnly),true);
    if (Result<>nil) then exit;
  end;
end;

function TLinkScanner.SearchIncludeFile(const AFilename: string;
  var NewCode: Pointer; var MissingIncludeFile: TMissingIncludeFile): boolean;
var PathStart, PathEnd: integer;
  IncludePath, PathDivider, CurPath: string;
  ExpFilename: string;
  SecondaryFilename: String;

  function SearchPath(const APath: string): boolean;
  begin
    Result:=false;
    if APath='' then exit;
    if APath[length(APath)]<>PathDelim then
      ExpFilename:=APath+PathDelim+AFilename
    else
      ExpFilename:=APath+AFilename;
    if not FilenameIsAbsolute(ExpFilename) then
      ExpFilename:=ExtractFilePath(FMainSourceFilename)+ExpFilename;
    NewCode:=LoadSourceCaseSensitive(ExpFilename);
    Result:=NewCode<>nil;
  end;
  
  procedure SetMissingIncludeFile;
  begin
    if MissingIncludeFile=nil then
      MissingIncludeFile:=TMissingIncludeFile.Create(AFilename,'');
    MissingIncludeFile.IncludePath:=IncludePath;
  end;

begin
  {$IFDEF VerboseIncludeSearch}
  DebugLn('TLinkScanner.SearchIncludeFile Filename="',AFilename,'"');
  {$ENDIF}
  IncludePath:='';
  if not Assigned(FOnLoadSource) then begin
    NewCode:=nil;
    SetMissingIncludeFile;
    Result:=false;
    exit;
  end;
  // if include filename is absolute then load it directly
  if FilenameIsAbsolute(AFilename) then begin
    NewCode:=LoadSourceCaseSensitive(AFilename);
    Result:=(NewCode<>nil);
    if not Result then SetMissingIncludeFile;
    exit;
  end;
  // include filename is relative
  
  // first search include file in the directory of the main source
  {$IFDEF VerboseIncludeSearch}
  DebugLn('TLinkScanner.SearchIncludeFile MainSourceFilename="',FMainSourceFilename,'"');
  {$ENDIF}
  if FilenameIsAbsolute(FMainSourceFilename) then begin
    // main source has absolute filename
    ExpFilename:=ExtractFilePath(FMainSourceFilename)+AFilename;
    NewCode:=LoadSourceCaseSensitive(ExpFilename);
    Result:=(NewCode<>nil);
    if Result then exit;
  end else begin
    // main source has relative filename (= virtual)
    NewCode:=FOnLoadSource(Self,TrimFilename(AFilename),true);
    if NewCode=nil then begin
      SecondaryFilename:=lowercase(AFilename);
      if SecondaryFilename<>AFilename then
        NewCode:=FOnLoadSource(Self,TrimFilename(SecondaryFilename),true);
    end;
    if NewCode=nil then begin
      SecondaryFilename:=UpperCaseStr(AFilename);
      if SecondaryFilename<>AFilename then
        NewCode:=FOnLoadSource(Self,TrimFilename(SecondaryFilename),true);
    end;
    Result:=(NewCode<>nil);
    if Result then exit;
  end;
  
  // then search the include file in the include path
  if MissingIncludeFile=nil then
    IncludePath:=Values.Variables[ExternalMacroStart+'INCPATH']
  else
    IncludePath:=MissingIncludeFile.IncludePath;
    
  if Values.IsDefined('DELPHI') then
    PathDivider:=':'
  else
    PathDivider:=':;';
  {$IFDEF VerboseIncludeSearch}
  DebugLn('TLinkScanner.SearchIncludeFile IncPath="',IncludePath,'" PathDivider="',PathDivider,'"');
  {$ENDIF}
  PathStart:=1;
  PathEnd:=PathStart;
  while PathEnd<=length(IncludePath) do begin
    if ((Pos(IncludePath[PathEnd],PathDivider))>0)
    {$IFDEF win32}
    and (not ((PathEnd-PathStart=1) // ignore colon in drive
          and (IncludePath[PathEnd]=':')
          and (IsWordChar[IncludePath[PathEnd-1]])))
    {$ENDIF}
    then begin
      if PathEnd>PathStart then begin
        CurPath:=TrimFilename(copy(IncludePath,PathStart,PathEnd-PathStart));
        Result:=SearchPath(CurPath);
        if Result then exit;
      end;
      PathStart:=PathEnd+1;
      PathEnd:=PathStart;
    end else
      inc(PathEnd);
  end;
  if PathEnd>PathStart then begin
    CurPath:=TrimFilename(copy(IncludePath,PathStart,PathEnd-PathStart));
    Result:=SearchPath(CurPath);
    if Result then exit;
  end;
  SetMissingIncludeFile;
end;

function TLinkScanner.IncludeFile(const AFilename: string): boolean;
var
  NewCode: Pointer;
  MissingIncludeFile: TMissingIncludeFile;
begin
  MissingIncludeFile:=nil;
  Result:=SearchIncludeFile(AFilename, NewCode, MissingIncludeFile);
  if Result then begin
    // change source
    if Assigned(FOnIncludeCode) then
      FOnIncludeCode(FMainCode,NewCode);
    SetSource(NewCode);
    AddLink(CleanedLen+1,SrcPos,Code);
  end else begin
    if MissingIncludeFile<>nil then begin
      if FMissingIncludeFiles=nil then
        FMissingIncludeFiles:=TMissingIncludeFiles.Create;
      FMissingIncludeFiles.Add(MissingIncludeFile);
    end;
    if (not IgnoreMissingIncludeFiles) then begin
      RaiseExceptionFmt(ctsIncludeFileNotFound,[AFilename])
    end else begin
      // add a dummy link
      AddLink(CleanedLen+1,SrcPos,MissingIncludeFileCode);
      AddLink(CleanedLen+1,SrcPos,Code);
    end;
  end;
end;

function TLinkScanner.IfDirective: boolean;
// {$if expression} or indirectly called by {$elseif expression}
var Expr, ResultStr: string;
begin
  inc(IfLevel);
  inc(SrcPos);
  Expr:=UpperCaseStr(copy(Src,SrcPos,CommentInnerEndPos-SrcPos));
  ResultStr:=Values.Eval(Expr);
  Result:=true;
  if Values.ErrorPosition>=0 then
    RaiseException(ctsErrorInDirectiveExpression)
  else if ResultStr='0' then
    SkipTillEndifElse
end;

function TLinkScanner.IfOptDirective: boolean;
// {$ifopt o+} or {$ifopt o-}
var Option, c: char;
begin
  inc(IfLevel);
  inc(SrcPos);
  Option:=UpChars[Src[SrcPos]];
  if (IsWordChar[Option]) and (CompilerSwitchesNames[Option]<>'')
  then begin
    inc(SrcPos);
    if (SrcPos<=SrcLen) then begin
      c:=Src[SrcPos];
      if c in ['+','-'] then begin
        if (c='-')<>(Values.Variables[CompilerSwitchesNames[Option]]='0') then
          SkipTillEndifElse;
      end;
    end;
  end;
  Result:=true;
end;

procedure TLinkScanner.SetIgnoreMissingIncludeFiles(const Value: boolean);
begin
  FIgnoreMissingIncludeFiles := Value;
end;

procedure TLinkScanner.PushIncludeLink(ACleanedPos, ASrcPos: integer;
  ACode: pointer);
  
  procedure RaiseIncludeCircleDetected;
  begin
    RaiseException(ctsIncludeCircleDetected);
  end;
  
var NewLink: PSourceLink;
  i: integer;
begin
  for i:=0 to FIncludeStack.Count-1 do
    if PSourceLink(FIncludeStack[i])^.Code=ACode then
      RaiseIncludeCircleDetected;
  NewLink:=PSourceLinkMemManager.NewPSourceLink;
  with NewLink^ do begin
    CleanedPos:=ACleanedPos;
    SrcPos:=ASrcPos;
    Code:=ACode;
  end;
  FIncludeStack.Add(NewLink);
end;

function TLinkScanner.PopIncludeLink: TSourceLink;
var PLink: PSourceLink;
begin
  PLink:=PSourceLink(FIncludeStack[FIncludeStack.Count-1]);
  Result:=PLink^;
  PSourceLinkMemManager.DisposePSourceLink(PLink);
  FIncludeStack.Delete(FIncludeStack.Count-1);
end;

function TLinkScanner.GetIncludeFileIsMissing: boolean;
begin
  Result:=(FMissingIncludeFiles<>nil);
end;

function TLinkScanner.MissingIncludeFilesNeedsUpdate: boolean;
var
  i: integer;
  MissingIncludeFile: TMissingIncludeFile;
  NewCode: Pointer;
begin
  Result:=false;
  if (not IncludeFileIsMissing) or IgnoreMissingIncludeFiles then exit;
  { last scan missed an include file (i.e. was not in searchpath)
    -> Check all missing include files again }
  for i:=0 to FMissingIncludeFiles.Count-1 do begin
    MissingIncludeFile:=FMissingIncludeFiles[i];
    if SearchIncludeFile(MissingIncludeFile.Filename,NewCode,MissingIncludeFile)
    then begin
      Result:=true;
      exit;
    end;
  end;
end;

procedure TLinkScanner.ClearMissingIncludeFiles;
begin
  FreeAndNil(FMissingIncludeFiles);
end;

function TLinkScanner.ReturnFromIncludeFile: boolean;
var OldPos: TSourceLink;
begin
  if not FSkippingTillEndif then begin
    {$IFDEF ShowUpdateCleanedSrc}
    DebugLn('TLinkScanner.ReturnFromIncludeFile A UpdatePos=',DbgS(SrcPos-1));
    {$ENDIF}
    UpdateCleanedSource(SrcPos-1);
  end;
  while SrcPos>SrcLen do begin
    Result:=FIncludeStack.Count>0;
    if not Result then exit;
    OldPos:=PopIncludeLink;
    SetSource(OldPos.Code);
    SrcPos:=OldPos.SrcPos;
    LastCleanSrcPos:=SrcPos-1;
    AddLink(CleanedLen+1,SrcPos,Code);
  end;
  Result:=SrcPos<=SrcLen;
end;

procedure TLinkScanner.InitKeyWordList;
begin
  if KeywordFuncList<>nil then exit;
  KeywordFuncList:=TKeyWordFunctionList.Create;
  with KeywordFuncList do begin
    Add('END'            ,@DoEndToken);
    Add('IMPLEMENTATION' ,@DoEndOfInterfaceToken);
    Add('INITIALIZIATION',@DoEndOfInterfaceToken);
    Add('FINALIZATION'   ,@DoEndOfInterfaceToken);
    DefaultKeyWordFunction:=@DoDefaultIdentToken;
  end;
end;

function TLinkScanner.DoEndToken: boolean;
begin
  TokenType:=lsttEnd;
  Result:=true;
end;

function TLinkScanner.DoDefaultIdentToken: boolean;
begin
  TokenType:=lsttIdentifier;
  Result:=true;
end;

function TLinkScanner.DoEndOfInterfaceToken: boolean;
begin
  TokenType:=lsttEndOfInterface;
  Result:=true;
end;

procedure TLinkScanner.SkipTillEndifElse;
var OldDirectiveFuncList: TKeyWordFunctionList;
  c1: Char;
begin
  SrcPos:=CommentEndPos;
  {$IFDEF ShowUpdateCleanedSrc}
  DebugLn('TLinkScanner.SkipTillEndifElse A UpdatePos=',DbgS(SrcPos-1));
  {$ENDIF}
  UpdateCleanedSource(SrcPos-1);
  OldDirectiveFuncList:=FDirectiveFuncList;
  FDirectiveFuncList:=FSkipDirectiveFuncList;
  try
    // parse till $else, $elseif or $endif without adding the code to FCleanedSrc
    FSkippingTillEndif:=true;
    FSkipIfLevel:=IfLevel;
    if (SrcPos<=SrcLen) then begin
      while true do begin
        c1:=Src[SrcPos];
        if IsCommentStartChar[c1] then begin
          case c1 of
            '{': begin
                   SkipComment;
                   if not FSkippingTillEndif then break;
                 end;
            '/': if (Src[SrcPos+1]='/') then begin
                   SkipDelphiComment;
                   if not FSkippingTillEndif then break;
                 end else
                   inc(SrcPos);
            '(': if (Src[SrcPos+1]='*') then begin
                   SkipOldTPComment;
                   if not FSkippingTillEndif then break;
                 end else
                   inc(SrcPos);
          end;
        end else if c1='''' then begin
          // skip string constant
          inc(SrcPos);
          while (SrcPos<=SrcLen) and (Src[SrcPos]<>'''') do inc(SrcPos);
          inc(SrcPos);
        end else begin
          inc(SrcPos);
          if (SrcPos>SrcLen) and not ReturnFromIncludeFile then
            break;
        end;
      end;
    end;
    LastCleanSrcPos:=CommentStartPos-1;
    AddLink(CleanedLen+1,CommentStartPos,Code);
    {$IFDEF ShowUpdateCleanedSrc}
    DebugLn('TLinkScanner.SkipTillEndifElse B Continuing after: ',
      '"',StringToPascalConst(copy(Src,LastCleanSrcPos+1,20)),'"');
    {$ENDIF}
  finally
    FDirectiveFuncList:=OldDirectiveFuncList;
    FSkippingTillEndif:=false;
  end;
end;

procedure TLinkScanner.SetCompilerMode(const AValue: TCompilerMode);
begin
  if FCompilerMode=AValue then exit;
  FCompilerMode:=AValue;
  FNestedComments:=(PascalCompiler=pcFPC)
                   and (FCompilerMode in [cmFPC,cmOBJFPC]);
end;

function TLinkScanner.SkipIfDirective: boolean;
begin
  inc(IfLevel);
  Result:=true;
end;

function TLinkScanner.CursorToCleanPos(ACursorPos: integer; ACode: pointer;
  var ACleanPos: integer): integer;
// 0=valid CleanPos
//-1=CursorPos was skipped, CleanPos is between two links
// 1=CursorPos beyond scanned code
var
  i, j, SkippedCleanPos: integer;
  SkippedPos: boolean;
begin
  i:=0;
  SkippedPos:=false;
  SkippedCleanPos:=-1;
  while i<LinkCount do begin
    //DebugLn('[TLinkScanner.CursorToCleanPos] A ACursorPos=',ACursorPos,', Code=',Links[i].Code=ACode,', Links[i].SrcPos=',Links[i].SrcPos,', Links[i].CleanedPos=',Links[i].CleanedPos);
    if (FLinks[i].Code=ACode) and (FLinks[i].SrcPos<=ACursorPos) then begin
      // link in same code found
      ACleanPos:=ACursorPos-FLinks[i].SrcPos+FLinks[i].CleanedPos;
      //DebugLn('[TLinkScanner.CursorToCleanPos] B ACleanPos=',ACleanPos);
      if i+1<LinkCount then begin
        // link has successor
        //DebugLn('[TLinkScanner.CursorToCleanPos] C Links[i+1].CleanedPos=',Links[i+1].CleanedPos);
        if ACleanPos<FLinks[i+1].CleanedPos then begin
          // link covers the cursor position
          Result:=0;  // valid position
          exit;
        end;
        // set found cleanpos to end of link
        ACleanPos:=FLinks[i].CleanedPos+LinkSize(i);
        // link does not cover the cursor position
        // find the next link in the same code
        j:=i+1;
        while (j<LinkCount) and (FLinks[j].Code<>ACode) do inc(j);
        //DebugLn('[TLinkScanner.CursorToCleanPos] D j=',j);
        if (j<LinkCount) and (FLinks[j].SrcPos>ACursorPos) then begin
          if not SkippedPos then begin
            // CursorPos was skipped, CleanPos is between two links
            // but because include files can be parsed multiple times,
            // search must continue
            SkippedPos:=true;
            SkippedCleanPos:=ACleanPos;
          end;
          // if this is an double included file,
          // this position can be in clean code -> search next
        end;
        // search next
        i:=j-1;
      end else begin
        // in last link
        //DebugLn('[TLinkScanner.CursorToCleanPos] E length(FCleanedSrc)=',length(FCleanedSrc));
        if ACleanPos<=length(FCleanedSrc) then begin
          Result:=0;  // valid position
          exit;
        end;
        break;
      end;
    end;
    inc(i);
  end;
  if SkippedPos then begin
    Result:=-1;
    ACleanPos:=SkippedCleanPos;
  end else
    Result:=1; // default: CursorPos beyond/outside scanned code
end;

function TLinkScanner.CleanedPosToCursor(ACleanedPos: integer;
  var ACursorPos: integer; var ACode: Pointer): boolean;

  procedure ConsistencyCheckI(i: integer);
  begin
    raise Exception.Create(
      'TLinkScanner.CleanedPosToCursor Consistency-Error '+IntToStr(i));
  end;

var l,r,m: integer;
begin
  Result:=(ACleanedPos>=1) and (ACleanedPos<=CleanedLen);
  if Result then begin
    // ACleanedPos in Cleaned Code -> binary search through the links
    l:=0;
    r:=LinkCount-1;
    while l<=r do begin
      m:=(l+r) div 2;
      if m<LinkCount-1 then begin
        if ACleanedPos<FLinks[m].CleanedPos then
          r:=m-1
        else if ACleanedPos>=FLinks[m+1].CleanedPos then
          l:=m+1
        else begin
          ACode:=FLinks[m].Code;
          ACursorPos:=ACleanedPos-FLinks[m].CleanedPos+FLinks[m].SrcPos;
          exit;
        end;
      end else begin
        if ACleanedPos>=FLinks[m].CleanedPos then begin
          ACode:=FLinks[m].Code;
          ACursorPos:=ACleanedPos-FLinks[m].CleanedPos+FLinks[m].SrcPos;
          exit;
        end else
          ConsistencyCheckI(2);
      end;
    end;
    ConsistencyCheckI(1);
  end;
end;

function TLinkScanner.WholeRangeIsWritable(CleanStartPos, CleanEndPos: integer;
  ErrorOnFail: boolean): boolean;
  
  procedure EditError(const AMessage: string; ACode: Pointer);
  begin
    if ErrorOnFail then
      RaiseEditException(AMessage,ACode,0);
  end;
  
var
  ACode: Pointer;
  LinkIndex: integer;
  CodeIsReadOnly: boolean;
begin
  Result:=false;
  if (CleanStartPos<1) or (CleanStartPos>=CleanEndPos)
  or (CleanEndPos>CleanedLen+1) or (not Assigned(FOnGetSourceStatus)) then begin
    EditError('TLinkScanner.WholeRangeIsWritable: Invalid range',nil);
    exit;
  end;
  LinkIndex:=LinkIndexAtCleanPos(CleanStartPos);
  if LinkIndex<0 then begin
    EditError('TLinkScanner.WholeRangeIsWritable: position out of scan range',nil);
    exit;
  end;
  ACode:=FLinks[LinkIndex].Code;
  FOnGetSourceStatus(Self,ACode,CodeIsReadOnly);
  if CodeIsReadOnly then begin
    EditError(ctsfileIsReadOnly, ACode);
    exit;
  end;
  repeat
    inc(LinkIndex);
    if (LinkIndex>=LinkCount) or (FLinks[LinkIndex].CleanedPos>CleanEndPos) then
    begin
      Result:=true;
      exit;
    end;
    if ACode<>FLinks[LinkIndex].Code then begin
      ACode:=FLinks[LinkIndex].Code;
      FOnGetSourceStatus(Self,ACode,CodeIsReadOnly);
      if CodeIsReadOnly then begin
        EditError(ctsfileIsReadOnly, ACode);
        exit;
      end;
    end;
  until false;
end;

procedure TLinkScanner.FindCodeInRange(CleanStartPos, CleanEndPos: integer;
  UniqueSortedCodeList: TFPList);
var ACode: Pointer;
  LinkIndex: integer;
begin
  if (CleanStartPos<1) or (CleanStartPos>CleanEndPos)
  or (CleanEndPos>CleanedLen+1) or (UniqueSortedCodeList=nil) then exit;
  LinkIndex:=LinkIndexAtCleanPos(CleanStartPos);
  if LinkIndex<0 then exit;
  ACode:=FLinks[LinkIndex].Code;
  AddCodeToUniqueList(ACode,UniqueSortedCodeList);
  repeat
    inc(LinkIndex);
    if (LinkIndex>=LinkCount) or (FLinks[LinkIndex].CleanedPos>CleanEndPos) then
      exit;
    if ACode<>FLinks[LinkIndex].Code then begin
      ACode:=FLinks[LinkIndex].Code;
      AddCodeToUniqueList(ACode,UniqueSortedCodeList);
    end;
  until false;
end;

procedure TLinkScanner.DeleteRange(CleanStartPos,CleanEndPos: integer);
{ delete all code in links (=parsed code) starting with the last link
  before you call this, test with WholeRangeIsWritable

  this can do unexpected things if
    - include files are included twice
    - compiler directives like IFDEF - ENDIF are partially destroyed
    
  ToDo: keep include directives
}
var LinkIndex, StartPos, Len, aLinkSize: integer;
begin
  if (CleanStartPos<1) or (CleanStartPos>=CleanEndPos)
  or (CleanEndPos>CleanedLen+1) or (not Assigned(FOnDeleteSource)) then exit;
  LinkIndex:=LinkIndexAtCleanPos(CleanEndPos-1);
  while LinkIndex>=0 do begin
    StartPos:=CleanStartPos-FLinks[LinkIndex].CleanedPos;
    if StartPos<0 then StartPos:=0;
    aLinkSize:=LinkSize(LinkIndex);
    if CleanEndPos<FLinks[LinkIndex].CleanedPos+aLinkSize then
      Len:=CleanEndPos-FLinks[LinkIndex].CleanedPos-StartPos
    else
      Len:=aLinkSize-StartPos;
    inc(StartPos,FLinks[LinkIndex].SrcPos);
    FOnDeleteSource(Self,FLinks[LinkIndex].Code,StartPos,Len);
    if FLinks[LinkIndex].CleanedPos<=CleanStartPos then break;
    dec(LinkIndex);
  end;
end;

procedure TLinkScanner.ActivateGlobalWriteLock;
begin
  if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(true);
end;

procedure TLinkScanner.DeactivateGlobalWriteLock;
begin
  if Assigned(OnSetGlobalWriteLock) then OnSetGlobalWriteLock(false);
end;

procedure TLinkScanner.RaiseExceptionFmt(const AMessage: string;
  args: array of const);
begin
  RaiseException(Format(AMessage,args));
end;

procedure TLinkScanner.RaiseException(const AMessage: string);
begin
  RaiseExceptionClass(AMessage,ELinkScannerError);
end;

procedure TLinkScanner.RaiseExceptionClass(const AMessage: string;
  ExceptionClass: ELinkScannerErrors);
begin
  LastErrorMessage:=AMessage;
  LastErrorSrcPos:=SrcPos;
  LastErrorCode:=Code;
  LastErrorCheckedForIgnored:=false;
  raise ExceptionClass.Create(Self,AMessage);
end;

procedure TLinkScanner.RaiseEditException(const AMessage: string;
  ABuffer: Pointer; ABufferPos: integer);
begin
  raise ELinkScannerEditError.Create(Self,AMessage,ABuffer,ABufferPos);
end;

procedure TLinkScanner.ClearLastError;
begin
  LastErrorIsValid:=false;
  LastErrorCheckedForIgnored:=false;
end;

procedure TLinkScanner.RaiseLastError;
begin
  SrcPos:=LastErrorSrcPos;
  Code:=LastErrorCode;
  RaiseException(LastErrorMessage);
end;

procedure TLinkScanner.DoCheckAbort;
begin
  if not Assigned(OnProgress) then exit;
  if OnProgress(Self) then exit;
  // mark scanning results as invalid
  FForceUpdateNeeded:=true;
  // raise abort exception
  RaiseExceptionClass('Abort',ELinkScannerAbort);
end;

function TLinkScanner.MainFilename: string;
begin
  if Assigned(OnGetFileName) and (Code<>nil) then
    Result:=OnGetFileName(Self,Code)
  else
    Result:='';
end;

{ ELinkScannerError }

constructor ELinkScannerError.Create(ASender: TLinkScanner;
  const AMessage: string);
begin
  inherited Create(AMessage);
  Sender:=ASender;
end;

{ TPSourceLinkMemManager }

procedure TPSourceLinkMemManager.FreeFirstItem;
var Link: PSourceLink;
begin
  Link:=PSourceLink(FFirstFree);
  PSourceLink(FFirstFree):=Link^.Next;
  Dispose(Link);
end;

procedure TPSourceLinkMemManager.DisposePSourceLink(Link: PSourceLink);
begin
  if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
  begin
    // add Link to Free list
    FillChar(Link^,SizeOf(TSourceLink),0);
    Link^.Next:=PSourceLink(FFirstFree);
    PSourceLink(FFirstFree):=Link;
    inc(FFreeCount);
  end else begin
    // free list full -> free Link
    Dispose(Link);
    {$IFDEF DebugCTMemManager}
    inc(FFreedCount);
    {$ENDIF}
  end;
  dec(FCount);
end;

function TPSourceLinkMemManager.NewPSourceLink: PSourceLink;
begin
  if FFirstFree<>nil then begin
    // take from free list
    Result:=PSourceLink(FFirstFree);
    PSourceLink(FFirstFree):=Result^.Next;
    Result^.Next:=nil;
    dec(FFreeCount);
  end else begin
    // free list empty -> create new PSourceLink
    New(Result);
    FillChar(Result^,SizeOf(TSourceLink),0);
    {$IFDEF DebugCTMemManager}
    inc(FAllocatedCount);
    {$ENDIF}
  end;
  inc(FCount);
end;

{ TPSourceChangeStep }

procedure TPSourceChangeStepMemManager.FreeFirstItem;
var Step: PSourceChangeStep;
begin
  Step:=PSourceChangeStep(FFirstFree);
  PSourceChangeStep(FFirstFree):=Step^.Next;
  Dispose(Step);
end;

procedure TPSourceChangeStepMemManager.DisposePSourceChangeStep(
  Step: PSourceChangeStep);
begin
  if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
  begin
    // add Link to Free list
    FillChar(Step^,SizeOf(TSourceChangeStep),0);
    Step^.Next:=PSourceChangeStep(FFirstFree);
    PSourceChangeStep(FFirstFree):=Step;
    inc(FFreeCount);
  end else begin
    // free list full -> free Step
    Dispose(Step);
    {$IFDEF DebugCTMemManager}
    inc(FFreedCount);
    {$ENDIF}
  end;
  dec(FCount);
end;

function TPSourceChangeStepMemManager.NewPSourceChangeStep: PSourceChangeStep;
begin
  if FFirstFree<>nil then begin
    // take from free list
    Result:=PSourceChangeStep(FFirstFree);
    PSourceChangeStep(FFirstFree):=Result^.Next;
    Result^.Next:=nil;
    dec(FFreeCount);
  end else begin
    // free list empty -> create new PSourceChangeStep
    New(Result);
    FillChar(Result^,SizeOf(TSourceChangeStep),0);
    {$IFDEF DebugCTMemManager}
    inc(FAllocatedCount);
    {$ENDIF}
  end;
  inc(FCount);
end;

{ TMissingIncludeFile }

constructor TMissingIncludeFile.Create(const AFilename, AIncludePath: string);
begin
  inherited Create;
  Filename:=AFilename;
  IncludePath:=AIncludePath;
end;

{ TMissingIncludeFiles }

function TMissingIncludeFiles.GetIncFile(Index: Integer): TMissingIncludeFile;
begin
  Result:=TMissingIncludeFile(Get(Index));
end;

procedure TMissingIncludeFiles.SetIncFile(Index: Integer;
  const AValue: TMissingIncludeFile);
begin
  Put(Index,AValue);
end;

procedure TMissingIncludeFiles.Clear;
var i: integer;
begin
  for i:=0 to Count-1 do Items[i].Free;
  inherited Clear;
end;

procedure TMissingIncludeFiles.Delete(Index: Integer);
begin
  Items[Index].Free;
  inherited Delete(Index);
end;


//------------------------------------------------------------------------------
procedure InternalInit;
var c: char;
  CompMode: TCompilerMode;
begin
  for c:=Low(char) to high(char) do begin
    IsLineEndChar[c]:=c in [#10,#13];
    IsSpaceChar[c]:=c in [#0..#32];
    IsIdentStartChar[c]:=c in ['a'..'z','A'..'Z','_'];
    IsIdentChar[c]:=c in ['a'..'z','A'..'Z','_','0'..'9'];
    IsNumberChar[c]:=c in ['0'..'9'];
    IsCommentStartChar[c]:=c in ['/','{','('];
    IsCommentEndChar[c]:=c in ['}',')',#13,#10];
    IsHexNumberChar[c]:=c in ['0'..'9','a'..'f','A'..'F'];
    IsEqualOperatorStartChar[c]:=c in [':','+','-','/','*','<','>'];
    IsWordChar[c]:=c in ['a'..'z','A'..'Z'];
    IsAfterFloatPointChar[c]:=c in ['0'..'9','e','E'];
  end;
  for CompMode:=Low(TCompilerMode) to High(TCompilerMode) do
    CompilerModeVars[CompMode]:='FPC_'+CompilerModeNames[CompMode];
  PSourceLinkMemManager:=TPSourceLinkMemManager.Create;
  PSourceChangeStepMemManager:=TPSourceChangeStepMemManager.Create;
end;

procedure InternalFinal;
begin
  PSourceChangeStepMemManager.Free;
  PSourceLinkMemManager.Free;
end;

{ ELinkScannerEditError }

constructor ELinkScannerEditError.Create(ASender: TLinkScanner;
  const AMessage: string; ABuffer: Pointer; ABufferPos: integer);
begin
  inherited Create(ASender,AMessage);
  Buffer:=ABuffer;
  BufferPos:=ABufferPos;
end;

initialization
  InternalInit;
  
finalization
  InternalFinal;

end.