{
 ***************************************************************************
 *                                                                         *
 *   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:
    TCodeCache is an AVL Tree of TCodeBuffer. It can load and save files.
    
    TCodeBuffer is an descendent of TSourceLog and manages a single file.
    
}
unit CodeCache;

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

interface

{$I codetools.inc}

uses
  {$IFDEF MEM_CHECK}
  MemCheck,
  {$ENDIF}
  Classes, SysUtils, SourceLog, LinkScanner, FileProcs,
  Avl_Tree, Laz_XMLCfg;

const
  IncludeLinksFileVersion = 2;
type
  TCodeCache = class;
  
  { TCodeBuffer }

  TCodeBuffer = class(TSourceLog)
  private
    FFilename: string;
    FReferenceCount: integer;
    FScanner: TLinkScanner;
    FOnSetScanner: TNotifyEvent;
    FOnSetFilename: TNotifyEvent;
    FFileChangeStep: integer;
    FLoadDateValid: boolean;
    FLoadDate: longint;
    FLastIncludedByFile: string;
    FCodeCache: TCodeCache;
    FIsVirtual: boolean;
    FIsDeleted: boolean;
    FAutoDiskRevertLock: integer;
    FGlobalWriteLockStepOnLastLoad: integer;
    function GetLastIncludedByFile: string;
    procedure SetFilename(Value: string);
    procedure SetScanner(const Value: TLinkScanner);
    procedure SetIsDeleted(const NewValue: boolean);
  protected
    procedure IncreaseChangeStep; override;
    procedure DecodeLoaded(const AFilename: string;
                    var ASource, ADiskEncoding, AMemEncoding: string); override;
    procedure EncodeSaving(const AFilename: string; var ASource: string); override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear; override;
    procedure ConsistencyCheck;
    procedure WriteDebugReport;
    function CalcMemSize: PtrUInt; override;
    function LoadFromFile(const AFilename: string): boolean; override;
    function Reload: boolean; // = LoadFromFile(Filename)
    function Revert: boolean; // ignore changes and reload source
    function SaveToFile(const AFilename: string): boolean; override;
    function Save: boolean;
    function FileDateOnDisk: longint;
    function FileNeedsUpdate: boolean;
    function FileOnDiskNeedsUpdate: boolean;
    function FileOnDiskHasChanged: boolean;
    function FileOnDiskIsEqual: boolean;
    function AutoRevertFromDisk: boolean;
    procedure LockAutoDiskRevert;
    procedure UnlockAutoDiskRevert;
    procedure IncrementRefCount;
    procedure ReleaseRefCount;
    procedure MakeFileDateValid;
    function SourceIsText: boolean;
  public
    property CodeCache: TCodeCache read FCodeCache write FCodeCache;
    property Filename: string read FFilename write SetFilename;
    property GlobalWriteLockStepOnLastLoad: integer
       read FGlobalWriteLockStepOnLastLoad write FGlobalWriteLockStepOnLastLoad;
    property IsDeleted: boolean read FIsDeleted write SetIsDeleted;
    property IsVirtual: boolean read FIsVirtual;
    property LastIncludedByFile: string read GetLastIncludedByFile
                                        write FLastIncludedByFile;
    property LoadDate: longint read FLoadDate;
    property LoadDateValid: boolean read FLoadDateValid;
    property OnSetFilename: TNotifyEvent read FOnSetFilename write FOnSetFilename;
    property OnSetScanner: TNotifyEvent read FOnSetScanner write FOnSetScanner;
    property Scanner: TLinkScanner read FScanner write SetScanner;
    property ReferenceCount: integer read FReferenceCount;
  end;
  
  { TIncludedByLink }

  TIncludedByLink = class
  public
    IncludeFilename: string;
    IncludedByFile: string;
    LastTimeUsed: TDateTime;
    constructor Create(const AnIncludeFilename,AnIncludedByFile: string;
       ALastTimeUsed: TDateTime);
    function CalcMemSize: PtrUInt;
  end;

  TOnCodeCacheDecodeLoaded = procedure(Code: TCodeBuffer; const Filename: string;
                        var Source, DiskEncoding, MemEncoding: string) of object;
  TOnCodeCacheEncodeSaving = procedure(Code: TCodeBuffer;
                          const Filename: string; var Source: string) of object;

  { TCodeCache }

  TCodeCache = class(TObject)
  private
    FChangeStamp: int64;
    FDefaultEncoding: string;
    FItems: TAVLTree;  // tree of TCodeBuffer
    FIncludeLinks: TAVLTree; // tree of TIncludedByLink
    FDestroying: boolean;
    FExpirationTimeInDays: integer;
    FGlobalWriteLockIsSet: boolean;
    FGlobalWriteLockStep: integer;
    fLastIncludeLinkFile: string;
    fLastIncludeLinkFileAge: integer;
    fLastIncludeLinkFileValid: boolean;
    fLastIncludeLinkFileChangeStep: integer;
    fChangeStep: integer;
    FOnDecodeLoaded: TOnCodeCacheDecodeLoaded;
    FOnEncodeSaving: TOnCodeCacheEncodeSaving;
    function FindIncludeLink(const IncludeFilename: string): string;
    function FindIncludeLinkNode(const IncludeFilename: string): TIncludedByLink;
    function FindIncludeLinkAVLNode(const IncludeFilename: string): TAVLTreeNode;
    function OnScannerCheckFileOnDisk(Code: pointer): boolean;
    function OnScannerGetFileName(Sender: TObject; Code: pointer): string;
    function OnScannerGetSource(Sender: TObject; Code: pointer): TSourceLog;
    function OnScannerLoadSource(Sender: TObject; const AFilename: string;
                                 OnlyIfExists: boolean): pointer;
    procedure OnScannerDeleteSource(Sender: TObject; Code: Pointer;
                 Pos, Len: integer);
    procedure OnScannerGetSourceStatus(Sender: TObject; Code:Pointer;
                 var ReadOnly: boolean);
    procedure OnScannerIncludeCode(ParentCode, IncludeCode: pointer);
    procedure UpdateIncludeLinks;
    procedure IncreaseChangeStep;
    procedure DecodeLoaded(Code: TCodeBuffer; const AFilename: string;
                           var ASource, ADiskEncoding, AMemEncoding: string);
    procedure EncodeSaving(Code: TCodeBuffer;
                           const AFilename: string; var ASource: string);
  public
    constructor Create;
    destructor Destroy;  override;
    procedure ConsistencyCheck;
    function Count: integer;
    function CreateFile(const AFilename: string): TCodeBuffer;
    function FindFile(AFilename: string): TCodeBuffer;
    function LastIncludedByFile(const IncludeFilename: string): string;
    function LoadFile(const AFilename: string): TCodeBuffer;
    procedure RemoveCodeBuffer(Buffer: TCodeBuffer);
    procedure LoadIncludeLinksDataFromList(List: TStrings);
    function LoadIncludeLinksFromFile(const AFilename: string): boolean;
    function LoadIncludeLinksFromXML(XMLConfig: TXMLConfig;
                                     const XMLPath: string): boolean;
    function SaveBufferAs(OldBuffer: TCodeBuffer; const AFilename: string;
                          out NewBuffer: TCodeBuffer): boolean;
    procedure SaveIncludeLinksDataToList(List: TStrings);
    function SaveIncludeLinksToFile(const AFilename: string;
                                    OnlyIfChanged: boolean): boolean;
    function SaveIncludeLinksToXML(XMLConfig: TXMLConfig;
                                   const XMLPath: string): boolean;
    procedure Clear;
    procedure ClearAllSourceLogEntries;
    procedure ClearIncludedByEntry(const IncludeFilename: string);
    procedure OnBufferSetFileName(Sender: TCodeBuffer;
          const OldFilename: string);
    procedure OnBufferSetScanner(Sender: TCodeBuffer);
    procedure WriteAllFileNames;
    procedure WriteDebugReport;
    function CalcMemSize(Stats: TCTMemStats): PtrUInt;
    procedure IncreaseChangeStamp;
  public
    property ExpirationTimeInDays: integer
          read FExpirationTimeInDays write FExpirationTimeInDays;
    property GlobalWriteLockIsSet: boolean
          read FGlobalWriteLockIsSet write FGlobalWriteLockIsSet;
    property GlobalWriteLockStep: integer
          read FGlobalWriteLockStep write FGlobalWriteLockStep;
    property OnDecodeLoaded: TOnCodeCacheDecodeLoaded read FOnDecodeLoaded
                                                      write FOnDecodeLoaded;
    property OnEncodeSaving: TOnCodeCacheEncodeSaving read FOnEncodeSaving
                                                      write FOnEncodeSaving;
    property DefaultEncoding: string read FDefaultEncoding write FDefaultEncoding;
    property ChangeStamp: int64 read FChangeStamp;
  end;


implementation


function CompareCodeBuffers(NodeData1, NodeData2: pointer): integer;
var CodeBuf1, CodeBuf2: TCodeBuffer;
begin
  CodeBuf1:=TCodeBuffer(NodeData1);
  CodeBuf2:=TCodeBuffer(NodeData2);
  Result:=CompareFilenames(CodeBuf1.Filename,CodeBuf2.Filename);
end;

function CompareIncludedByLink(NodeData1, NodeData2: pointer): integer;
var Link1, Link2: TIncludedByLink;
begin
  Link1:=TIncludedByLink(NodeData1);
  Link2:=TIncludedByLink(NodeData2);
  Result:=CompareFilenames(Link1.IncludeFilename,Link2.IncludeFilename);
end;

function ComparePAnsiStringWithIncludedByLink(Key, Data: pointer): integer;
begin
  Result:=CompareFilenames(PAnsiString(Key)^,
                           TIncludedByLink(Data).IncludeFilename);
end;

{ TCodeCache }

procedure TCodeCache.Clear;
begin
  FItems.FreeAndClear;
end;

procedure TCodeCache.ClearAllSourceLogEntries;
var
  ANode: TAVLTreeNode;
begin
  ANode:=FItems.FindLowest;
  while ANode<>nil do begin
    TCodeBuffer(ANode.Data).ClearEntries;
    ANode:=FItems.FindSuccessor(ANode);
  end;
end;

procedure TCodeCache.ClearIncludedByEntry(const IncludeFilename: string);
var Code: TCodeBuffer;
  Node: TAVLTreeNode;
begin
  Code:=FindFile(IncludeFilename);
  if Code<>nil then
    Code.LastIncludedByFile:=''
  else begin
    Node:=FindIncludeLinkAVLNode(IncludeFilename);
    if Node<>nil then
      FIncludeLinks.FreeAndDelete(Node);
  end;
end;

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

constructor TCodeCache.Create;
begin
  inherited Create;
  FItems:=TAVLTree.Create(@CompareCodeBuffers);
  FIncludeLinks:=TAVLTree.Create(@CompareIncludedByLink);
end;

destructor TCodeCache.Destroy;
begin
  FDestroying:=true;
  Clear;
  FIncludeLinks.FreeAndClear;
  FIncludeLinks.Free;
  FItems.Free;
  inherited Destroy;
end;

function TCodeCache.FindFile(AFilename: string): TCodeBuffer;
var c: integer;
  ANode: TAVLTreeNode;
begin
  AFilename:=TrimFilename(AFilename);
  ANode:=FItems.Root;
  while ANode<>nil do begin
    Result:=TCodeBuffer(ANode.Data);
    c:=CompareFilenames(AFilename,Result.Filename);
    {$IFDEF CTDEBUG}
    if c=0 then DebugLn(' File found !!! ',Result.Filename);
    {$ENDIF}
    if c<0 then ANode:=ANode.Left
    else if c>0 then ANode:=ANode.Right
    else exit;
  end;
  Result:=nil;
end;

function TCodeCache.LoadFile(const AFilename: string): TCodeBuffer;
// search file in cache
begin
  Result:=FindFile(AFilename);
  if FilenameIsAbsolute(AFilename) then begin
    if Result=nil then begin
      // load new buffer
      Result:=TCodeBuffer.Create;
      if (not FileExistsCached(AFilename)) then begin
        Result.Free;
        Result:=nil;
        exit;
      end;
      Result.Filename:=GetFilenameOnDisk(AFilename);
      Result.FCodeCache:=Self;
      if (not Result.LoadFromFile(Result.Filename)) then
      begin
        Result.FCodeCache:=nil;
        Result.Free;
        Result:=nil;
        exit;
      end;
      FItems.Add(Result);
      with Result do begin
        LastIncludedByFile:=FindIncludeLink(Result.Filename);
        ReadOnly:=not FileIsWritable(Result.Filename);
      end;
    end else if Result.IsDeleted then begin
      // file in cache, but marked as deleted -> load from disk
      if (not FileExistsCached(AFilename))
      or (not Result.LoadFromFile(AFilename)) then
      begin
        Result:=nil;
      end;
    end;
  end else begin
    // virtual file
    if (Result <> nil) and Result.IsDeleted then begin
      // file in cache, but marked as deleted -> no virtual file
      Result:=nil;
    end;
  end;
end;

procedure TCodeCache.RemoveCodeBuffer(Buffer: TCodeBuffer);
begin
  if not FDestroying then
    FItems.Remove(Buffer);
end;

procedure TCodeCache.LoadIncludeLinksDataFromList(List: TStrings);
{ First line is the base date as DateToCfgStr

  The following lines are compressed. Each line starting with a number of
  characters to use from the previous line. Then a colon and the rest of the
  line.
  Each include link has two lines, the first is the IncludeFilename, the
  second the the IncludedByFile plus semicolon and the age in days.
}
var
  BaseDate: TDateTime;
  LastLine: string;
  Index: integer;

  function NextLine: string;
  begin
    // skip empty lines
    repeat
      if Index>=List.Count then begin
        Result:='';
        exit;
      end;
      Result:=List[Index];
      inc(Index);
    until Result<>'';
  end;

  function NextUncompressedLine: string;
  var
    p: Integer;
    Same: Integer;
  begin
    Result:=NextLine;
    p:=1;
    Same:=0;
    while (p<=length(Result)) and (Result[p] in ['0'..'9']) do begin
      Same:=Same*10+ord(Result[p])-ord('0');
      inc(p);
    end;
    while (p<=length(Result)) and (Result[p]<>':') do inc(p);
    Result:=copy(LastLine,1,Same)+copy(Result,p+1,length(Result));
    LastLine:=Result;
    //debugln(['NextUncompressedLine "',Result,'"']);
  end;

var
  IncludeFilename: String;
  IncludedByFile: String;
  p: Longint;
  Days: LongInt;
  Link: TIncludedByLink;
  LastTimeUsed: TDateTime;
  CurrDate: TDateTime;
begin
  FIncludeLinks.FreeAndClear;
  Index:=0;
  CurrDate:=Date;
  LastLine:='';
  if not CfgStrToDate(NextLine,BaseDate) then BaseDate:=Date;
  repeat
    IncludeFilename:=TrimFilename(NextUncompressedLine);
    if IncludeFilename='' then exit;
    IncludedByFile:=TrimFilename(NextUncompressedLine);
    if IncludedByFile='' then begin
      debugln(['TCodeCache.LoadIncludeLinksDataFromList missing IncludedByFile: IncludeFilename=',IncludeFilename,' line=',Index]);
      exit;
    end;
    if not FilenameIsAbsolute(IncludedByFile) then begin
      debugln(['TCodeCache.LoadIncludeLinksDataFromList ignoring relative IncludedByFile: IncludeFilename=',IncludeFilename,' line=',Index]);
      exit;
    end;
    p:=System.Pos(';',IncludedByFile);
    if p<1 then begin
      debugln(['TCodeCache.LoadIncludeLinksDataFromList missing age in IncludedByFile line: ',IncludedByFile,' line=',Index]);
      exit;
    end;
    Days:=StrToIntDef(copy(IncludedByFile,p+1,length(IncludedByFile)),0);
    IncludedByFile:=copy(IncludedByFile,1,p-1);
    LastTimeUsed:=BaseDate-Days;
    //debugln(['TCodeCache.LoadIncludeLinksDataFromList ',IncludeFilename,' ',IncludedByFile,' ',LastTimeUsed]);
    if (FExpirationTimeInDays<=0)
    or (CurrDate-LastTimeUsed<=FExpirationTimeInDays) then begin
      Link:=FindIncludeLinkNode(IncludeFilename);
      if Link=nil then begin
        Link:=TIncludedByLink.Create(IncludeFilename,IncludedByFile,
                                     BaseDate-Days);
        FIncludeLinks.Add(Link);
      end else if Link.LastTimeUsed<=LastTimeUsed then begin
        Link.IncludedByFile:=IncludedByFile;
        Link.LastTimeUsed:=LastTimeUsed;
      end;
    end;
  until false;
end;

function TCodeCache.CreateFile(const AFilename: string): TCodeBuffer;
begin
  Result:=FindFile(AFileName);
  if Result<>nil then begin
    Result.Clear;
  end else begin
    Result:=TCodeBuffer.Create;
    Result.FileName:=AFileName;
    FItems.Add(Result);
    Result.FCodeCache:=Self;// must be called after FileName:=
    Result.LastIncludedByFile:=FindIncludeLink(Result.Filename);
  end;
  Result.DiskEncoding:=DefaultEncoding;
  Result.MemEncoding:=Result.DiskEncoding;
end;

function TCodeCache.SaveBufferAs(OldBuffer: TCodeBuffer; 
  const AFilename: string; out NewBuffer: TCodeBuffer): boolean;
begin
  //DebugLn('[TCodeCache.SaveBufferAs] ',OldBuffer.Filename,' ',AFilename);
  if (OldBuffer=nil) then begin
    NewBuffer:=nil;
    Result:=false;
    exit;
  end;
  if OldBuffer.Filename=AFilename then begin // do not use CompareFilenames() !
    NewBuffer:=OldBuffer;
    Result:=OldBuffer.Save;
    exit;
  end;
  NewBuffer:=FindFile(AFilename);
  //DebugLn('[TCodeCache.SaveBufferAs] B ',NewBuffer=nil);
  //WriteAllFileNames;
  if NewBuffer=nil then begin
    NewBuffer:=TCodeBuffer.Create;
    NewBuffer.FileName:=AFilename;
    NewBuffer.Source:=OldBuffer.Source;
    NewBuffer.DiskEncoding:=NewBuffer.DiskEncoding;
    NewBuffer.MemEncoding:=NewBuffer.MemEncoding;
    NewBuffer.FCodeCache:=Self;
    Result:=NewBuffer.IsVirtual or NewBuffer.Save;
    //DebugLn('[TCodeCache.SaveBufferAs] C ',Result,' ',NewBuffer.IsVirtual);
    if not Result then begin
      NewBuffer.FCodeCache:=nil;
      NewBuffer.Free;
      NewBuffer:=nil;
      exit;
    end;
    FItems.Add(NewBuffer);
    NewBuffer.LastIncludedByFile:=FindIncludeLink(AFilename);
  end else begin
    NewBuffer.Source:=OldBuffer.Source;
    NewBuffer.IsDeleted:=false;
    Result:=NewBuffer.Save;
  end;
  if not Result then exit;
  if (OldBuffer<>NewBuffer) then begin
    OldBuffer.IsDeleted:=true;
    OldBuffer.Source:='';
  end;
end;

procedure TCodeCache.SaveIncludeLinksDataToList(List: TStrings);
{ First line is the base date as DateToCfgStr

  The following lines are compressed. Each line starting with a number of
  characters to use from the previous line. Then a colon and the rest of the
  line.
  Each include link has two lines, the first is the IncludeFilename, the
  second the the IncludedByFile plus semicolon and the age in days.
}
var
  LastLine: String;
  CurrDate: TDateTime;
  ExpirationTime: TDateTime;
  Node: TAVLTreeNode;

  procedure AddLine(Line: string);
  var
    p1: PChar;
    p2: PChar;
    p: PtrUint;
  begin
    p1:=PChar(Line);
    p2:=PChar(LastLine);
    while (p1^=p2^) and (p1^<>#0) do begin
      inc(p1);
      inc(p2);
    end;
    p:=p1-PChar(Line);
    List.Add(IntToStr(p)+':'+copy(Line,p+1,length(Line)));
    LastLine:=Line;
  end;

var
  ALink: TIncludedByLink;
  DiffTime: TDateTime;
begin
  UpdateIncludeLinks;
  if FIncludeLinks.Count=0 then exit;
  ExpirationTime:=TDateTime(FExpirationTimeInDays);
  LastLine:='';
  CurrDate:=Date;
  List.Add(DateToCfgStr(CurrDate));
  Node:=FIncludeLinks.FindLowest;
  while Node<>nil do begin
    ALink:=TIncludedByLink(Node.Data);
    DiffTime:=CurrDate-ALink.LastTimeUsed;
    if (FExpirationTimeInDays<=0) or (DiffTime<ExpirationTime) then begin
      AddLine(ALink.IncludeFilename);
      AddLine(ALink.IncludedByFile+';'+IntToStr(round(CurrDate-ALink.LastTimeUsed)));
    end;
    Node:=FIncludeLinks.FindSuccessor(Node);
  end;
end;

function TCodeCache.LastIncludedByFile(const IncludeFilename: string): string;
var Code: TCodeBuffer;
begin
  Code:=FindFile(IncludeFilename);
  if Code<>nil then
    Result:=Code.LastIncludedByFile
  else begin
    Result:=FindIncludeLink(IncludeFilename);
  end;
end;

procedure TCodeCache.OnBufferSetScanner(Sender: TCodeBuffer);
begin
  with Sender do begin
    if Scanner<>nil then begin
      Scanner.OnGetSource:={$ifdef FPC}@{$endif}Self.OnScannerGetSource;
      Scanner.OnGetFileName:={$ifdef FPC}@{$endif}Self.OnScannerGetFileName;
      Scanner.OnLoadSource:={$ifdef FPC}@{$endif}Self.OnScannerLoadSource;
      Scanner.OnCheckFileOnDisk:=
          {$ifdef FPC}@{$endif}Self.OnScannerCheckFileOnDisk;
      Scanner.OnIncludeCode:={$ifdef FPC}@{$endif}Self.OnScannerIncludeCode;
      Scanner.OnGetSourceStatus:=
          {$ifdef FPC}@{$endif}Self.OnScannerGetSourceStatus;
      Scanner.OnDeleteSource:={$ifdef FPC}@{$endif}Self.OnScannerDeleteSource;
    end;
  end;
end;

procedure TCodeCache.OnBufferSetFileName(Sender: TCodeBuffer;
  const OldFilename: string);
begin
  FItems.Delete(FItems.Find(FindFile(OldFilename)));
  if FindFile(Sender.Filename)=nil then
    FItems.Add(Sender);
end;

function TCodeCache.OnScannerGetFileName(Sender: TObject;
  Code: pointer): string;
begin
  if (Code<>nil) then
    Result:=TCodeBuffer(Code).Filename
  else
    raise Exception.Create('[TCodeCache.OnScannerGetFilename] Code=nil');
end;

function TCodeCache.OnScannerGetSource(Sender: TObject;
  Code: pointer): TSourceLog;
begin
//DebugLn('[TCodeCache.OnScannerGetSource] A ',DbgS(Code),'/',Count);
  if (Code<>nil) then
    Result:=TSourceLog(Code)
  else
    raise Exception.Create('[TCodeCache.OnScannerGetFilename] Code=nil');
end;

function TCodeCache.OnScannerLoadSource(Sender: TObject;
  const AFilename: string; OnlyIfExists: boolean): pointer;
begin
  if OnlyIfExists then begin
    Result:=FindFile(AFilename);
    if (Result=nil)
    and (FilenameIsAbsolute(AFilename) and FileExistsCached(AFilename)) then
      Result:=LoadFile(AFilename);
  end else
    Result:=LoadFile(AFilename);
  //debugln(['TCodeCache.OnScannerLoadSource ']);
  if Result<>nil then
    OnScannerCheckFileOnDisk(Result);
end;

function TCodeCache.OnScannerCheckFileOnDisk(Code: pointer): boolean;
var Buf: TCodeBuffer;
begin
  Buf:=TCodeBuffer(Code);
  //DebugLn(['OnScannerCheckFileOnDisk A ',Buf.Filename,' AutoRev=',Buf.AutoRevertFromDisk,' WriteLock=',GlobalWriteLockIsSet,' DiskChg=',Buf.FileOnDiskHasChanged,' IsDeleted=',Buf.IsDeleted]);
  if Buf.AutoRevertFromDisk or Buf.IsDeleted then begin
    if GlobalWriteLockIsSet then begin
      if GlobalWriteLockStep<>Buf.GlobalWriteLockStepOnLastLoad then begin
        Buf.GlobalWriteLockStepOnLastLoad:=GlobalWriteLockStep;
        if Buf.FileNeedsUpdate then
          Buf.Revert;
      end;
    end else begin
      if Buf.FileNeedsUpdate then
        Buf.Revert;
    end;
  end else begin
    //DebugLn(['TCodeCache.OnScannerCheckFileOnDisk AutoRevertFromDisk=',Buf.AutoRevertFromDisk,' ',Buf.Filename]);
  end;
  //if buf.IsDeleted then debugln(['TCodeCache.OnScannerCheckFileOnDisk ',Buf.Filename,' still deleted']);
  Result:=true;
end;

procedure TCodeCache.OnScannerIncludeCode(ParentCode, IncludeCode: pointer);
var
  CodeBuffer: TCodeBuffer;
begin
  if (ParentCode<>nil) and (IncludeCode<>nil) and (ParentCode<>IncludeCode) then
  begin
    CodeBuffer:=TCodeBuffer(IncludeCode);
    if CodeBuffer.LastIncludedByFile=TCodeBuffer(ParentCode).Filename then exit;
    CodeBuffer.LastIncludedByFile:=TCodeBuffer(ParentCode).Filename;
    IncreaseChangeStep;
  end;
end;

procedure TCodeCache.OnScannerGetSourceStatus(Sender: TObject; Code:Pointer;
  var ReadOnly: boolean);
begin
  ReadOnly:=TCodeBuffer(Code).ReadOnly;
end;

procedure TCodeCache.OnScannerDeleteSource(Sender: TObject; Code: Pointer;
  Pos, Len: integer);
begin
  TCodeBuffer(Code).Delete(Pos,Len);
end;

function TCodeCache.FindIncludeLinkNode(const IncludeFilename: string
  ): TIncludedByLink;
var
  ANode: TAVLTreeNode;
  cmp: integer;
begin
  ANode:=FIncludeLinks.Root;
  while ANode<>nil do begin
    Result:=TIncludedByLink(ANode.Data);
    cmp:=CompareFilenames(IncludeFilename,Result.IncludeFilename);
    if cmp<0 then ANode:=ANode.Left
    else if cmp>0 then ANode:=ANode.Right
    else begin
      exit;
    end;
  end;
  Result:=nil;
end;

function TCodeCache.FindIncludeLinkAVLNode(const IncludeFilename: string
  ): TAVLTreeNode;
begin
  Result:=FIncludeLinks.FindKey(@IncludeFilename,
                                @ComparePAnsiStringWithIncludedByLink);
end;

function TCodeCache.FindIncludeLink(const IncludeFilename: string): string;
var Link: TIncludedByLink;
begin
  Link:=FindIncludeLinkNode(IncludeFilename);
  if Link<>nil then begin
    Result:=Link.IncludedByFile;
    if CompareFilenames(Result,IncludeFilename)=0 then Result:='';
  end else
    Result:='';
end;

procedure TCodeCache.UpdateIncludeLinks;
var CodeNode: TAVLTreeNode;
  IncludeNode: TIncludedByLink;
  Code: TCodeBuffer;
  CurrDate: TDateTime;
begin
  CodeNode:=FItems.FindLowest;
  CurrDate:=Date;
  while CodeNode<>nil do begin
    Code:=TCodeBuffer(CodeNode.Data);
    IncludeNode:=FindIncludeLinkNode(Code.Filename);
    if IncludeNode<>nil then begin
      // there is already an entry for this file -> update it
      IncludeNode.IncludedByFile:=Code.LastIncludedByFile;
      IncludeNode.LastTimeUsed:=CurrDate;
    end else if Code.LastIncludedByFile<>'' then begin
      // there is no entry for this include file -> add one
      FIncludeLinks.Add(TIncludedByLink.Create(Code.Filename,
                        Code.LastIncludedByFile,CurrDate));
    end;
    CodeNode:=FItems.FindSuccessor(CodeNode);
  end;
end;

procedure TCodeCache.IncreaseChangeStep;
begin
  inc(fChangeStep);
  if fChangeStep=$7fffffff then fChangeStep:=-$7fffffff;
end;

procedure TCodeCache.DecodeLoaded(Code: TCodeBuffer; const AFilename: string;
  var ASource, ADiskEncoding, AMemEncoding: string);
begin
  if Assigned(OnDecodeLoaded) then
    OnDecodeLoaded(Code,AFilename,ASource,ADiskEncoding,AMemEncoding);
end;

procedure TCodeCache.EncodeSaving(Code: TCodeBuffer; const AFilename: string;
  var ASource: string);
begin
  if Assigned(OnEncodeSaving) then
    OnEncodeSaving(Code,AFilename,ASource);
end;

function TCodeCache.SaveIncludeLinksToFile(const AFilename: string;
  OnlyIfChanged: boolean): boolean;
var XMLConfig: TXMLConfig;
begin
  try
    if OnlyIfChanged and fLastIncludeLinkFileValid
    and (fLastIncludeLinkFileChangeStep=fChangeStep)
    and (fLastIncludeLinkFile=AFilename)
    and FileExistsCached(AFilename)
    and (FileAgeCached(AFilename)=fLastIncludeLinkFileAge)
    then begin
      //debugln(['TCodeCache.SaveIncludeLinksToFile file valid']);
      exit;
    end;
    XMLConfig:=TXMLConfig.CreateClean(AFilename);
    try
      Result:=SaveIncludeLinksToXML(XMLConfig,'');
      fLastIncludeLinkFile:=AFilename;
      fLastIncludeLinkFileAge:=FileAgeCached(AFilename);
      fLastIncludeLinkFileChangeStep:=fChangeStep;
      fLastIncludeLinkFileValid:=true;
    finally
      XMLConfig.Free;
    end;
  except
    fLastIncludeLinkFileValid:=false;
    Result:=false;
  end;
end;

function TCodeCache.LoadIncludeLinksFromFile(const AFilename: string): boolean;
var XMLConfig: TXMLConfig;
begin
  try
    XMLConfig:=TXMLConfig.Create(AFilename);
    try
      Result:=LoadIncludeLinksFromXML(XMLConfig,'');
      fLastIncludeLinkFile:=AFilename;
      fLastIncludeLinkFileAge:=FileAgeCached(AFilename);
      fLastIncludeLinkFileChangeStep:=fChangeStep;
      fLastIncludeLinkFileValid:=true;
    finally
      XMLConfig.Free;
    end;
  except
    fLastIncludeLinkFileValid:=false;
    Result:=false;
  end;
end;

function TCodeCache.SaveIncludeLinksToXML(XMLConfig: TXMLConfig;
  const XMLPath: string): boolean;
var
  List: TStringList;
begin
  UpdateIncludeLinks;
  XMLConfig.SetValue(XMLPath+'IncludeLinks/Version',IncludeLinksFileVersion);
  XMLConfig.SetDeleteValue(XMLPath+'IncludeLinks/ExpirationTimeInDays',
      FExpirationTimeInDays,0);
  List:=TStringList.Create;
  try
    SaveIncludeLinksDataToList(List);
    XMLConfig.SetDeleteValue(XMLPath+'IncludeLinks/Data',List.Text,'');
  finally
    List.Free;
  end;
  Result:=true;
end;

function TCodeCache.LoadIncludeLinksFromXML(XMLConfig: TXMLConfig;
  const XMLPath: string): boolean;
var LinkCnt, i: integer;
  LastTimeUsed, CurrDate: TDateTime;
  IncludeFilename, IncludedByFile, APath: string;
  NewLink: TIncludedByLink;
  CurrDateStr: String;
  FileVersion: longint;
  List: TStringList;
begin
  FIncludeLinks.FreeAndClear;

  FileVersion:=XMLConfig.GetValue(XMLPath+'IncludeLinks/Version',0);
  FExpirationTimeInDays:=XMLConfig.GetValue(
      XMLPath+'IncludeLinks/ExpirationTimeInDays',
      FExpirationTimeInDays);
  if FileVersion=2 then begin
    List:=TStringList.Create;
    try
      List.Text:=XMLConfig.GetValue(XMLPath+'IncludeLinks/Data','');
      LoadIncludeLinksDataFromList(List);
    finally
      List.Free;
    end;
  end else if FileVersion<=1 then begin
    CurrDate:=Date;
    CurrDateStr:=DateToCfgStr(CurrDate);
    LinkCnt:=XMLConfig.GetValue(XMLPath+'IncludeLinks/Count',0);
    for i:=0 to LinkCnt-1 do begin
      APath:=XMLPath+'IncludeLinks/Link'+IntToStr(i)+'/';
      if not CfgStrToDate(XMLConfig.GetValue(APath+'LastTimeUsed/Value',
           CurrDateStr),LastTimeUsed)
      then begin
        debugln(['TCodeCache.LoadIncludeLinksFromXML invalid date: ',XMLConfig.GetValue(APath+'LastTimeUsed/Value','')]);
        LastTimeUsed:=CurrDate;
      end;
      // ToDo: check if link has expired

      IncludeFilename:=XMLConfig.GetValue(APath+'IncludeFilename/Value','');
      //debugln(['TCodeCache.LoadIncludeLinksFromXML CurrDate=',DateToStr(CurrDate),' xml=',XMLConfig.GetValue(APath+'LastTimeUsed/Value',''),' Days=',CurrDate-LastTimeUsed,' ',IncludeFilename]);
      if IncludeFilename='' then continue;
      IncludedByFile:=XMLConfig.GetValue(APath+'IncludedByFilename/Value','');
      if (FExpirationTimeInDays<=0)
      or (CurrDate-LastTimeUsed<=FExpirationTimeInDays) then begin
        NewLink:=TIncludedByLink.Create(IncludeFilename,IncludedByFile,
                                        LastTimeUsed);
        FIncludeLinks.Add(NewLink);
      end;
    end;
  end;
  Result:=true;
end;

procedure TCodeCache.ConsistencyCheck;
// 0 = ok
var ANode: TAVLTreeNode;
  CurResult: LongInt;
begin
  CurResult:=FItems.ConsistencyCheck;
  if CurResult<>0 then
    RaiseCatchableException(IntToStr(CurResult));
  CurResult:=FIncludeLinks.ConsistencyCheck;
  if CurResult<>0 then
    RaiseCatchableException(IntToStr(CurResult));
  ANode:=FItems.FindLowest;
  while ANode<>nil do begin
    if ANode.Data=nil then
      RaiseCatchableException('');
    TCodeBuffer(ANode.Data).ConsistencyCheck;
    ANode:=FItems.FindSuccessor(ANode);
  end;
  ANode:=FIncludeLinks.FindLowest;
  while ANode<>nil do begin
    if ANode.Data=nil then
      RaiseCatchableException('');
    ANode:=FIncludeLinks.FindSuccessor(ANode);
  end;
end;

procedure TCodeCache.WriteDebugReport;
begin
  DebugLn('[TCodeCache.WriteDebugReport]');
  DebugLn(FItems.ReportAsString);
  DebugLn(FIncludeLinks.ReportAsString);
  ConsistencyCheck;
end;

function TCodeCache.CalcMemSize(Stats: TCTMemStats): PtrUInt;
var
  m: PtrUInt;
  Node: TAVLTreeNode;
  IncLink: TIncludedByLink;
  Buf: TCodeBuffer;
begin
  Result:=PtrUInt(InstanceSize)
     +MemSizeString(FDefaultEncoding)
     +MemSizeString(fLastIncludeLinkFile);
  Stats.Add('TCodeCache',Result);
  if FItems<>nil then begin
    m:=FItems.Count*SizeOf(Node);
    Node:=FItems.FindLowest;
    while Node<>nil do begin
      Buf:=TCodeBuffer(Node.Data);
      inc(m,Buf.CalcMemSize);
      Node:=FItems.FindSuccessor(Node);
    end;
    Stats.Add('TCodeCache.Items.Count',FItems.Count);
    Stats.Add('TCodeCache.Items',m);
    inc(Result,m);
  end;
  if FIncludeLinks<>nil then begin
    m:=FIncludeLinks.Count*SizeOf(Node);
    Node:=FIncludeLinks.FindLowest;
    while Node<>nil do begin
      IncLink:=TIncludedByLink(Node.Data);
      inc(m,IncLink.CalcMemSize);
      Node:=FIncludeLinks.FindSuccessor(Node);
    end;
    Stats.Add('TCodeCache.FIncludeLinks.Count',FIncludeLinks.Count);
    Stats.Add('TCodeCache.FIncludeLinks',m);
    inc(Result,m);
  end;
end;

procedure TCodeCache.IncreaseChangeStamp;
begin
  if FChangeStamp<high(FChangeStamp) then
    inc(FChangeStamp)
  else
    FChangeStamp:=low(FChangeStamp);
end;

procedure TCodeCache.WriteAllFileNames;
  procedure WriteNode(ANode: TAVLTreeNode);
  begin
    if ANode=nil then exit;
    WriteNode(ANode.Left);
    DebugLn('  ',TCodeBuffer(ANode.Data).Filename);
    WriteNode(ANode.Right);
  end;

begin
  DebugLn('TCodeCache.WriteAllFileNames: ',dbgs(FItems.Count));
  WriteNode(FItems.Root);
end;

{ TCodeBuffer }

constructor TCodeBuffer.Create;
begin
  inherited Create('');
  FFilename:='';
  FLastIncludedByFile:='';
  FLoadDateValid:=false;
  FIsVirtual:=true;
  FIsDeleted:=false;
end;

destructor TCodeBuffer.Destroy;
begin
  if Scanner<>nil then Scanner.Free;
  if FCodeCache<>nil then FCodeCache.RemoveCodeBuffer(Self);
  inherited Destroy;
end;

procedure TCodeBuffer.Clear;
begin
  FIsDeleted:=false;
  FLoadDateValid:=false;
  inherited Clear;
end;

function TCodeBuffer.LoadFromFile(const AFilename: string): boolean;
begin
  //DebugLn('[TCodeBuffer.LoadFromFile] WriteLock=',WriteLock,' ReadOnly=',ReadOnly,
  //' IsVirtual=',IsVirtual,' Old="',Filename,'" ',CompareFilenames(AFilename,Filename));
  if (WriteLock>0) or ReadOnly then begin
    Result:=false;
    exit;
  end;
  if not IsVirtual then begin
    if CompareFilenames(AFilename,Filename)=0 then begin
      //DebugLn('****** [TCodeBuffer.LoadFromFile] ',Filename,' FileDateValid=',FileDateValid,' ',FFileDate,',',FileAgeUTF8(Filename),',',FFileChangeStep,',',ChangeStep,', NeedsUpdate=',FileNeedsUpdate);
      if FileNeedsUpdate then begin
        Result:=inherited LoadFromFile(AFilename);
        if Result then MakeFileDateValid;
      end else
        Result:=true;
    end else begin
      Result:=inherited LoadFromFile(AFilename);
      if Result then MakeFileDateValid;
    end;
    if Result then IsDeleted:=false;
  end else
    Result:=false;
end;

function TCodeBuffer.SaveToFile(const AFilename: string): boolean;
begin
  Result:=inherited SaveToFile(AFilename);
  //DebugLn(['TCodeBuffer.SaveToFile ',Filename,' -> ',AFilename,' ',Result]);
  if CompareFilenames(AFilename,Filename)=0 then begin
    if Result then begin
      IsDeleted:=false;
      MakeFileDateValid;
      Modified:=false;
    end;
  end;
end;

function TCodeBuffer.Reload: boolean;
begin
  Result:=LoadFromFile(Filename);
end;

function TCodeBuffer.Revert: boolean;
// ignore changes and reload source
begin
  if not IsVirtual then begin
    Result:=inherited LoadFromFile(Filename);
    if Result then MakeFileDateValid;
  end else
    Result:=false;
end;

function TCodeBuffer.Save: boolean;
begin
  if not IsVirtual then
    Result:=SaveToFile(Filename)
  else
    Result:=false;
end;

function TCodeBuffer.GetLastIncludedByFile: string;
begin
  Result:=FLastIncludedByFile;
  if Result=Filename then Result:='';
end;

procedure TCodeBuffer.SetFilename(Value: string);
var OldFilename: string;
begin
  Value:=TrimFilename(Value);
  if FFilename=Value then exit;
  OldFilename:=FFilename;
  FFilename := Value;
  FIsVirtual:=not FilenameIsAbsolute(Filename);
  if CompareFilenames(OldFileName,Value)<>0 then begin
    FLoadDateValid:=false;
  end;
  FLastIncludedByFile:='';
  if FCodeCache<>nil then FCodeCache.OnBufferSetFilename(Self,OldFilename);
  if Assigned(FOnSetFilename) then FOnSetFilename(Self);
end;

procedure TCodeBuffer.SetScanner(const Value: TLinkScanner);
begin
  if FScanner=Value then exit;
  FScanner := Value;
  if Assigned(FOnSetScanner) then FOnSetScanner(Self);
  if FCodeCache<>nil then FCodeCache.OnBufferSetScanner(Self);
  if FScanner<>nil then
    FScanner.MainCode:=Self;
end;

procedure TCodeBuffer.SetIsDeleted(const NewValue: boolean);
begin
  if FIsDeleted=NewValue then exit;
  //debugln(['TCodeBuffer.SetIsDeleted ',Filename,' ',NewValue]);
  IncreaseChangeStep;
  FIsDeleted:=NewValue;
  if FIsDeleted then begin
    Clear;
    FIsDeleted:=true;
    //DebugLn(['TCodeBuffer.SetIsDeleted ',Filename,' ',FileNeedsUpdate]);
  end;
end;

procedure TCodeBuffer.IncreaseChangeStep;
begin
  inherited IncreaseChangeStep;
  if FCodeCache<>nil then
    FCodeCache.IncreaseChangeStamp;
end;

procedure TCodeBuffer.DecodeLoaded(const AFilename: string; var ASource,
  ADiskEncoding, AMemEncoding: string);
begin
  inherited DecodeLoaded(AFilename,ASource,ADiskEncoding,AMemEncoding);
  if CodeCache<>nil then
    CodeCache.DecodeLoaded(Self,AFilename,ASource,ADiskEncoding,AMemEncoding);
end;

procedure TCodeBuffer.EncodeSaving(const AFilename: string; var ASource: string
  );
begin
  inherited EncodeSaving(AFilename,ASource);
  if CodeCache<>nil then
    CodeCache.EncodeSaving(Self,AFilename,ASource);
end;

procedure TCodeBuffer.MakeFileDateValid;
begin
  FFileChangeStep:=ChangeStep;
  FLoadDateValid:=true;
  FLoadDate:=FileAgeCached(Filename);
end;

function TCodeBuffer.SourceIsText: boolean;
var
  l: LongInt;
  i: Integer;
  s: String;
begin
  l:=SourceLength;
  if l>1024 then l:=1024;
  s:=Source;
  for i:=1 to l do
    if s[i] in [#0..#8,#11..#12,#14..#31] then exit(false);
  Result:=true;
end;

function TCodeBuffer.FileDateOnDisk: longint;
begin
  Result:=FileAgeCached(Filename);
end;

function TCodeBuffer.FileNeedsUpdate: boolean;
// file needs update (to be loaded), if file is not modified and file on disk has changed
begin
  if Modified then exit(false);
  if LoadDateValid then
    Result:=(FFileChangeStep=ChangeStep) and (FileDateOnDisk<>LoadDate)
  else
    Result:=true;
end;

function TCodeBuffer.FileOnDiskNeedsUpdate: boolean;
// file on disk needs update (to be saved), if memory is modified or file does not exist
begin
  if LoadDateValid then
    Result:=Modified or (FFileChangeStep<>ChangeStep)
            or (not FileExistsCached(Filename))
  else
    Result:=false;
end;

function TCodeBuffer.FileOnDiskHasChanged: boolean;
begin
  if LoadDateValid and FileExistsCached(Filename) then
    Result:=(FileDateOnDisk<>LoadDate)
  else
    Result:=false;
end;

function TCodeBuffer.FileOnDiskIsEqual: boolean;
begin
  Result:=(not FileOnDiskNeedsUpdate) and (not FileOnDiskHasChanged);
end;

function TCodeBuffer.AutoRevertFromDisk: boolean;
begin
  Result:=FAutoDiskRevertLock=0;
end;

procedure TCodeBuffer.LockAutoDiskRevert;
begin
  inc(FAutoDiskRevertLock);
end;

procedure TCodeBuffer.UnlockAutoDiskRevert;
begin
  if FAutoDiskRevertLock>0 then dec(FAutoDiskRevertLock);
end;

procedure TCodeBuffer.IncrementRefCount;
begin
  inc(FReferenceCount);
end;

procedure TCodeBuffer.ReleaseRefCount;
begin
  if FReferenceCount=0 then
    raise Exception.Create('TCodeBuffer.ReleaseRefCount');
  dec(FReferenceCount);
end;

procedure TCodeBuffer.ConsistencyCheck;
begin
  if FScanner<>nil then
    FScanner.ConsistencyCheck;
end;

procedure TCodeBuffer.WriteDebugReport;
begin
  DebugLn('[TCodeBuffer.WriteDebugReport] ');
  ConsistencyCheck;
end;

function TCodeBuffer.CalcMemSize: PtrUInt;
begin
  Result:=(inherited CalcMemSize)
    +MemSizeString(FFilename)
    +MemSizeString(FLastIncludedByFile);
end;

{ TIncludedByLink }

constructor TIncludedByLink.Create(const AnIncludeFilename,
  AnIncludedByFile: string; ALastTimeUsed: TDateTime);
begin
  inherited Create;
  IncludeFilename:=AnIncludeFilename;
  IncludedByFile:=AnIncludedByFile;
  LastTimeUsed:=ALastTimeUsed;
end;

function TIncludedByLink.CalcMemSize: PtrUInt;
begin
  Result:=PtrUInt(InstanceSize)
    +MemSizeString(IncludedByFile)
    +MemSizeString(IncludeFilename);
end;


end.