unit ABSPage;

{$I ABSVer.inc}

interface

uses Classes, Windows, Math,

// AbsoluteDatabase units
     {$IFDEF DEBUG_LOG}
     ABSDebug,
     {$ENDIF}
     ABSExcept,
     ABSMemory,
     ABSConst,
     ABSTypes;

type

  TABSPageManager = class;
  TABSSortedPageList = class;

////////////////////////////////////////////////////////////////////////////////
//
// TABSPage
//
////////////////////////////////////////////////////////////////////////////////
  TABSPageTableStateInfo = packed record
     TableState: Integer;
     IsTableStateValueAssigned: Boolean;
  end;

  TABSPage = class(TObject)
   private
     LPageManager:          TABSPageManager;
     FPageNo:               TABSPageNo;
     FPageBuffer:           TABSPageBuffer;
     FOwnBuffer:            Boolean;
     FIsDirty:              Boolean;
     FUseCount:             Integer;
     FParentList:           TABSSortedPageList;
     FSessionID:            TABSSessionID;
     FReloaded:             Boolean;
     FEncryptionEnabled:    Boolean;
     FTableStates:          array of TABSPageTableStateInfo;

     function GetPageHeader: PABSDiskPageHeader;
     function GetPageHeaderSize: Integer;
     function GetPageData: TABSPageBuffer;
     function GetPageDataSize: Integer;
     function GetPageSize: Integer;


   public
     procedure InitHeader;

     constructor Create(PageManager: TABSPageManager);
     destructor Destroy; override;
     procedure ClearPageBuffer;
     procedure AllocPageBuffer;
     procedure FreeAndNilPageBuffer;
     procedure EnlargePageBuffer(NewSize: Integer);
     procedure Synchronize;
     function GetTableState(SessionID: TABSSessionID; var TableState: Integer): Boolean;
     procedure SetTableState(SessionID: TABSSessionID; TableState: Integer);

     property PageNo: TABSPageNo read FPageNo write FPageNo;
     property PageSize: Integer read GetPageSize;
     property PageBuffer: TABSPageBuffer read FPageBuffer write FPageBuffer;
     property OwnBuffer: Boolean read FOwnBuffer write FOwnBuffer;
     property IsDirty: Boolean read FIsDirty write FIsDirty;
     property UseCount: Integer read FUseCount write FUseCount;
     property PageManager: TABSPageManager read LPageManager write LPageManager;
     property PageHeader: PABSDiskPageHeader read GetPageHeader;
     property PageHeaderSize: Integer read GetPageHeaderSize;
     property PageData: TABSPageBuffer read GetPageData;
     property PageDataSize: Integer read GetPageDataSize;
     property ParentList: TABSSortedPageList read FParentList write FParentList;
     property SessionID: TABSSessionID read FSessionID write FSessionID;
     property Reloaded: Boolean read FReloaded write FReloaded;
     property EncryptionEnabled: Boolean read FEncryptionEnabled write FEncryptionEnabled;
end;// TABSPage


////////////////////////////////////////////////////////////////////////////////
//
// TABSPageController
//
////////////////////////////////////////////////////////////////////////////////

  TABSPageController = class(TObject)
   private
    LPage:  TABSPage;
   protected
     procedure SetPageNo(Value: TABSPageNo);
     function GetPageNo: TABSPageNo;
     function GetPageSize: Integer;
     procedure SetPageBuffer(Value: TABSPageBuffer);
     function GetPageBuffer: TABSPageBuffer;
     procedure SetOwnBuffer(Value: Boolean);
     function GetOwnBuffer: Boolean;
     procedure SetIsDirty(Value: Boolean);
     function GetIsDirty: Boolean;
     procedure SetUseCount(Value: Integer);
     function GetUseCount: Integer;
     function GetPageManager: TABSPageManager;
     function GetPageData: TABSPageBuffer;
     function GetPageDataSize: Integer;
   public
     procedure EnlargePageBuffer(NewSize: Integer);

     property Page: TABSPage read LPage write LPage;
     property PageNo: TABSPageNo read GetPageNo write SetPageNo;
     property PageSize: Integer read GetPageSize;
     property PageBuffer: TABSPageBuffer read GetPageBuffer write SetPageBuffer;
     property OwnBuffer: Boolean read GetOwnBuffer write SetOwnBuffer;
     property IsDirty: Boolean read GetIsDirty write SetIsDirty;
     property UseCount: Integer read GetUseCount write SetUseCount;
     property PageManager: TABSPageManager read GetPageManager;
     property PageData: TABSPageBuffer read GetPageData;
     property PageDataSize: Integer read GetPageDataSize;
  end;// TABSPageController



////////////////////////////////////////////////////////////////////////////////
//
// TABSSortedPageList
//
////////////////////////////////////////////////////////////////////////////////

 TABSPageElement = record
   Page:     TABSPage;
   LRUCount: Int64;
 end;

 TABSSortedPageList = class(TObject)
  private
   KeyItems: array of integer;
   ItemCount: integer;
   AllocBy: integer;
   deAllocBy: integer;
   MaxAllocBy: integer;
   AllocItemCount: integer;
   LRUCount: Int64;
   LRULastFound: Integer;

   function FindPositionForInsert(key: Integer) : Integer;
   function FindPosition(key: Integer): Integer;
   procedure InsertByPosition(ItemNo, key: integer; var value: TABSPageElement);
   procedure DeleteByPosition(ItemNo: integer);

  public
   ValueItems: array of TABSPageElement;

   constructor Create(size: integer=0);
   procedure SetSize(newSize: integer);
   function Find(key: Integer): TABSPage;
   procedure Insert(Page: TABSPage);
   procedure Delete(PageNo: integer);
   procedure Clear;

   function FirstByLRU: TABSPage;
   function NextByLRU: TABSPage;
   procedure UpdateLRU(Page: TABSPage);

   property Count: Integer read ItemCount;
 end;//TABSSortedPageList


////////////////////////////////////////////////////////////////////////////////
//
// TABSPageManager
//
////////////////////////////////////////////////////////////////////////////////

  TABSSessionPageInfo = record
    SessionID:          TABSSessionID;
    DirtyPages:         TABSSortedPageList;
    AddedPageNumbers:   TABSPagesArray;
    RemovedPageNumbers: TABSPagesArray;
  end;

  TABSPageManager = class (TObject)
   protected
     FCSect:               TRTLCriticalSection;
     FCacheCapacity:       Integer;
     FSharedPages:         TABSSortedPageList;  // pages shared between all sessions
     FSessions:            array of TABSSessionPageInfo;

     FPageSize:            Word;
     FPageHeaderSize:      Word;
     FPageDataSize:        Word;
     FPageCount:           TABSPageNo;
     FMultiUser:           Boolean;
     FIgnoreCRCErrors:     Boolean;

     procedure Lock;
     procedure Unlock;
     function AddNewSession(SessionID: TABSSessionID): Integer;
     function FindSession(SessionID: TABSSessionID; var SessionNo: Integer): Boolean;
     function FindPage(Pages: TABSSortedPageList; PageNo: TABSPageNo; var Page: TABSPage): Boolean;
     procedure RemovePageIfExists(Pages: TABSSortedPageList; PageNo: TABSPageNo);

     function GetPageCount: TABSPageNo; virtual;

     function IsSafeNotToSyncPage(SessionID: TABSSessionID; Page: TABSPage): Boolean; virtual;
     procedure UpdatePageTableState(SessionID: TABSSessionID; Page: TABSPage); virtual;

   public
     procedure LoadFromStream(Stream: TStream); virtual;
     procedure SaveToStream(Stream: TStream); virtual;
     procedure InternalAddPage(aPage: TABSPage); virtual; abstract;
     procedure InternalRemovePage(PageNo: TABSPageNo); virtual; abstract;
     function InternalReadPage(aPage: TABSPage): Boolean; virtual; abstract;
     procedure InternalWritePage(aPage: TABSPage); virtual; abstract;
     constructor Create;
     destructor Destroy; override;
     function AddPage(SessionID: TABSSessionID; PageType: TABSPageTypeID): TABSPage;
     procedure RemovePage(SessionID: TABSSessionID; PageNo: TABSPageNo); virtual;
     function GetPage(SessionID: TABSSessionID; PageNo: TABSPageNo;
             PageType: TABSPageTypeID; SynchronizeAllowed: Boolean = True): TABSPage; virtual;
     procedure PutPage(aPage: TABSPage);
     procedure ApplyChanges(SessionID: TABSSessionID); virtual;
     procedure CancelChanges(SessionID: TABSSessionID);

     property PageSize: Word read FPageSize;
     property PageHeaderSize: Word read FPageHeaderSize;
     property PageDataSize: Word read FPageDataSize;
     property PageCount: TABSPageNo read GetPageCount;
     property MultiUser: Boolean read FMultiUser write FMultiUser;
     property IgnoreCRCErrors: Boolean read FIgnoreCRCErrors write FIgnoreCRCErrors;
  end; // TABSPageManager



implementation

uses ABSBTree, ABSBaseEngine, ABSDiskEngine;

////////////////////////////////////////////////////////////////////////////////
//
// TABSPage
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// GetPageHEader
//------------------------------------------------------------------------------
function TABSPage.GetPageHeader: PABSDiskPageHeader;
begin
  Result := PABSDiskPageHeader(FPageBuffer);
end; // GetPageHeader


//------------------------------------------------------------------------------
// GetPageData
//------------------------------------------------------------------------------
function TABSPage.GetPageHeaderSize: Integer;
begin
  Result := LPageManager.PageHeaderSize;
end;//GetPageHeaderSize


//------------------------------------------------------------------------------
// GetPageData
//------------------------------------------------------------------------------
function TABSPage.GetPageData: TABSPageBuffer;
begin
  Result := TABSPageBuffer(FPageBuffer + PageHeaderSize);
end;//GetPageData


//------------------------------------------------------------------------------
// GetPageDataSize
//------------------------------------------------------------------------------
function TABSPage.GetPageDataSize: Integer;
begin
  Result := PageSize - PageHeaderSize;
end;//GetPageDataSize


//------------------------------------------------------------------------------
// GetPageSize
//------------------------------------------------------------------------------
function TABSPage.GetPageSize: Integer;
begin
  Result := LPageManager.PageSize;
end;// GetPageSize


//------------------------------------------------------------------------------
// InitHeader
//------------------------------------------------------------------------------
procedure TABSPage.InitHeader;
begin
  PageHeader.Signature := ABSDiskPageSignature;
  PageHeader.State := 0;
  PageHeader.PageType := ptUnknown;
  PageHeader.NextPageNo := INVALID_PAGE_NO;
  PageHeader.CRC32 := 0;
  PageHeader.CRCType := 0;
  PageHeader.HashType := 0;
  PageHeader.Cipherype := 0;
  PageHeader.MACType := 0;
  PageHeader.ObjectID := INVALID_OBJECT_ID;
  PageHeader.RecordID.PageNo := INVALID_PAGE_NO;
  PageHeader.RecordID.PageItemNo := 0;
end;//InitHeader


//------------------------------------------------------------------------------
// constructor
//------------------------------------------------------------------------------
constructor TABSPage.Create(PageManager: TABSPageManager);
begin
  LPageManager := PageManager;
  FPageBuffer := nil;
  FPageNo := INVALID_PAGE_NO;
  FOwnBuffer := True;
  FIsDirty := False;
  FUseCount := 0;
  FReloaded := False;
  FEncryptionEnabled := True;
end;// Create


//------------------------------------------------------------------------------
// destructor
//------------------------------------------------------------------------------
destructor TABSPage.Destroy;
begin
  if (FOwnBuffer) then
    FreeAndNilPageBuffer;
end;// Destroy


//------------------------------------------------------------------------------
// ClearPageBuffer
//------------------------------------------------------------------------------
procedure TABSPage.ClearPageBuffer;
begin
  FillChar(FPageBuffer^,PageSize,00);
end;// ClearPageBuffer


//------------------------------------------------------------------------------
// AllocPageBuffer
//------------------------------------------------------------------------------
procedure TABSPage.AllocPageBuffer;
begin
  //FPageBuffer := MemoryManager.GetMem(PageSize);
  FPageBuffer := MemoryManager.AllocMem(PageSize);
  InitHeader;
end;// AllocPageBuffer


//------------------------------------------------------------------------------
// FreeAndNilPageBuffer
//------------------------------------------------------------------------------
procedure TABSPage.FreeAndNilPageBuffer;
begin
  if (FPageBuffer <> nil) then
   MemoryManager.FreeAndNillMem(FPageBuffer);
end;// FreeAndNilPageBuffer


//------------------------------------------------------------------------------
// EnlargePageBuffer
//------------------------------------------------------------------------------
procedure TABSPage.EnlargePageBuffer(NewSize: Integer);
var
  NewBuffer: TAbsPByte;
begin
  if (FPageBuffer = nil) then
   raise EABSException.Create(20038, ErrorAInvalidPageBuffer);
  if (NewSize < PageSize) then
   raise EABSException.Create(20039, ErrorAInvalidPageModification);

  if (FOwnBuffer) then
    MemoryManager.ReallocMem(FPageBuffer, NewSize)
  else
   begin
     NewBuffer := MemoryManager.AllocMem(NewSize);
     Move(FPageBuffer^, NewBuffer^, PageSize);
     FPageBuffer := NewBuffer;
     FOwnBuffer := True;
   end;
end;// EnlargePageBuffer


//------------------------------------------------------------------------------
// Synchronize
//------------------------------------------------------------------------------
procedure TABSPage.Synchronize;
{$IFDEF FILE_SERVER_VERSION}
var
  NewState: Integer;
{$ENDIF}
begin
{$IFDEF FILE_SERVER_VERSION}
  if (LPageManager is TABSDiskPageManager) then
    if (LPageManager.MultiUser) then
      begin
        NewState := TABSDiskPageManager(LPageManager).InternalReadPageState(PageNo);
        if ((NewState <> DELETED_PAGE_STATE) and (PageHeader^.State <> NewState)) then
          LPageManager.InternalReadPage(Self)
        else
          PageHeader^.State := NewState;
      end;
{$ENDIF}
end;// Synchronize


//------------------------------------------------------------------------------
// GetTableState
//------------------------------------------------------------------------------
function TABSPage.GetTableState(SessionID: TABSSessionID; var TableState: Integer): Boolean;
var
  Index: Integer;
begin
  Index := SessionID - MIN_SESSION_ID;
  if (Index < Length(FTableStates)) then
    begin
      Result := FTableStates[Index].IsTableStateValueAssigned;
      TableState := FTableStates[Index].TableState;
    end
  else
    Result := False;
end;// GetTableState


//------------------------------------------------------------------------------
// SetTableState
//------------------------------------------------------------------------------
procedure TABSPage.SetTableState(SessionID: TABSSessionID; TableState: Integer);
var
  Index: Integer;
  OldLength: Integer;
  i: Integer;
begin
  Index := SessionID - MIN_SESSION_ID;
  if (Index >= Length(FTableStates)) then
    begin
      OldLength := Length(FTableStates);
      SetLength(FTableStates, Index+1);
      for i:= OldLength to Index-1 do
        FTableStates[Index].IsTableStateValueAssigned := False;
    end;
  FTableStates[Index].IsTableStateValueAssigned := True;
  FTableStates[Index].TableState := TableState;
end;// SetTableState



////////////////////////////////////////////////////////////////////////////////
//
// TABSPageController
//
////////////////////////////////////////////////////////////////////////////////

//------------------------------------------------------------------------------
// SetPageNo
//------------------------------------------------------------------------------
procedure TABSPageController.SetPageNo(Value: TABSPageNo);
begin
  LPage.PageNo := Value;
end;// SetPageNo


//------------------------------------------------------------------------------
// GetPageNo
//------------------------------------------------------------------------------
function TABSPageController.GetPageNo: TABSPageNo;
begin
  Result := LPage.PageNo;
end;// GetPageNo


//------------------------------------------------------------------------------
// GetPageSize
//------------------------------------------------------------------------------
function TABSPageController.GetPageSize: Integer;
begin
  Result := LPage.PageSize;
end;// GetPageSize


//------------------------------------------------------------------------------
// SetPageBuffer
//------------------------------------------------------------------------------
procedure TABSPageController.SetPageBuffer(Value: TABSPageBuffer);
begin
  LPage.PageBuffer := Value;
end;// SetPageBuffer


//------------------------------------------------------------------------------
// GetPageBuffer
//------------------------------------------------------------------------------
function TABSPageController.GetPageBuffer: TABSPageBuffer;
begin
  Result := LPage.PageBuffer;
end;// GetPageBuffer


//------------------------------------------------------------------------------
// SetOwnBuffer
//------------------------------------------------------------------------------
procedure TABSPageController.SetOwnBuffer(Value: Boolean);
begin
  LPage.OwnBuffer := Value;
end;// SetOwnBuffer


//------------------------------------------------------------------------------
// GetOwnBuffer
//------------------------------------------------------------------------------
function TABSPageController.GetOwnBuffer: Boolean;
begin
  Result := LPage.OwnBuffer;
end;// GetOwnBuffer


//------------------------------------------------------------------------------
// SetIsDirty
//------------------------------------------------------------------------------
procedure TABSPageController.SetIsDirty(Value: Boolean);
begin
  LPage.IsDirty := Value;
end;// SetIsDirty


//------------------------------------------------------------------------------
// GetIsDirty
//------------------------------------------------------------------------------
function TABSPageController.GetIsDirty: Boolean;
begin
  Result := LPage.IsDirty;
end;// GetIsDirty


//------------------------------------------------------------------------------
// SetUseCount
//------------------------------------------------------------------------------
procedure TABSPageController.SetUseCount(Value: Integer);
begin
  LPage.UseCount := Value;
end;// SetUseCount


//------------------------------------------------------------------------------
// GetUseCount
//------------------------------------------------------------------------------
function TABSPageController.GetUseCount: Integer;
begin
  Result := LPage.UseCount;
end;// GetUseCount


//------------------------------------------------------------------------------
// GetPageManager
//------------------------------------------------------------------------------
function TABSPageController.GetPageManager: TABSPageManager;
begin
  Result := LPage.PageManager;
end;// GetPageManager


//------------------------------------------------------------------------------
// GetPageData
//------------------------------------------------------------------------------
function TABSPageController.GetPageData: TABSPageBuffer;
begin
  Result := LPage.PageData;
end;// GetPageData


//------------------------------------------------------------------------------
// GetPageDataSize
//------------------------------------------------------------------------------
function TABSPageController.GetPageDataSize: Integer;
begin
  Result := LPage.PageDataSize;
end;// GetPageDataSize


//------------------------------------------------------------------------------
// EnlargePageBuffer
//------------------------------------------------------------------------------
procedure TABSPageController.EnlargePageBuffer(NewSize: Integer);
begin
  LPage.EnlargePageBuffer(NewSize);
end;// EnlargePageBuffer



////////////////////////////////////////////////////////////////////////////////
//
// TABSSortedPageList
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// Construct array of specified size
//------------------------------------------------------------------------------
constructor TABSSortedPageList.Create(size: integer);
begin
 AllocBy := 1000; // default alloc
 deAllocBy := 1000; // default dealloc
 MaxAllocBy := 10000; // max alloc
 AllocItemCount := 0;
 LRUCount := 0;
 SetSize(size);
end;//Create


//------------------------------------------------------------------------------
// Delete an element by specified key
//------------------------------------------------------------------------------
procedure TABSSortedPageList.Delete(PageNo: integer);
var pos : Integer;
begin
 if (itemCount <= 0) then
  raise EABSException.Create(20165, ErrorADeleteFromArray);
 if (itemCount = 1) then
  DeleteByPosition(0)
 else
  begin
   pos := FindPosition(PageNo);
   if (pos < 0) then
     raise EABSException.Create(20166, ErrorADeleteFromArrayNotFound, [PageNo, itemCount]);
   DeleteByPosition(pos);
  end;
end;//Delete


//------------------------------------------------------------------------------
// Clear
//------------------------------------------------------------------------------
procedure TABSSortedPageList.Clear;
begin
  ItemCount := 0;
end;// Clear


//------------------------------------------------------------------------------
// FirstByLRU
//------------------------------------------------------------------------------
function TABSSortedPageList.FirstByLRU: TABSPage;
var
  bInit: Boolean;
  i: Integer;
begin
  bInit := False;
  Result := nil;
  for i := 0 to ItemCount-1 do
   if ((not bInit) or (ValueItems[i].LRUCount < LRULastFound)) then
     begin
       bInit := True;
       LRULastFound := ValueItems[i].LRUCount;
       Result := ValueItems[i].Page;
     end;
end;// FirstByLRU


//------------------------------------------------------------------------------
// NextByLRU
//------------------------------------------------------------------------------
function TABSSortedPageList.NextByLRU: TABSPage;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to ItemCount-1 do
   if (ValueItems[i].LRUCount < LRULastFound) then
     begin
       LRULastFound := ValueItems[i].LRUCount;
       Result := ValueItems[i].Page;
       break;
     end;
end;// NextByLRU


//------------------------------------------------------------------------------
// UpdateLRU
//------------------------------------------------------------------------------
procedure TABSSortedPageList.UpdateLRU(Page: TABSPage);
var
  pos: Integer;
begin
  pos := FindPosition(Page.PageNo);
  if (Pos = - 1) then
    raise EABSException.Create(20167, ErrorAPageNotFound);
  Inc(LRUCount);
  ValueItems[Pos].LRUCount := LRUCount;
end;// UpdateLRU


//------------------------------------------------------------------------------
// Delete an element at specified position
//------------------------------------------------------------------------------
procedure TABSSortedPageList.DeleteByPosition(ItemNo: integer);
begin
 if (itemNo < itemCount-1) then
  begin
   Move(KeyItems[itemNo+1],KeyItems[itemNo],
       (itemCount - itemNo-1) * sizeOf(integer));
   Move(ValueItems[itemNo+1],ValueItems[itemNo],
       (itemCount - itemNo-1) * sizeOf(ValueItems[0]));
  end;
 dec(ItemCount);
 SetSize(ItemCount);
end;//DeleteByPosition


//------------------------------------------------------------------------------
// Finds value for specified key
// returns nil if element was not found
//------------------------------------------------------------------------------
function TABSSortedPageList.Find(key: Integer): TABSPage;
var
  pos: Integer;
begin
 pos := FindPositionForInsert(key);
 if (pos >= itemCount) or (pos < 0) then
  Result := nil
 else
  if (KeyItems[pos] <> key) then
   Result := nil
 else
  Result := ValueItems[pos].Page;
end;//Find


//------------------------------------------------------------------------------
// Finds position for insert element
// returns -1 if element was not found
//------------------------------------------------------------------------------
function TABSSortedPageList.FindPosition(key: Integer): Integer;
begin
 Result := FindPositionForInsert(key);
 if (Result >= itemCount) or (Result < 0) then
  Result := -1
 else
  if (KeyItems[Result] <> key) then
   Result := -1;
end;//FindPosition


//------------------------------------------------------------------------------
// Finds position for insert element
//------------------------------------------------------------------------------
function TABSSortedPageList.FindPositionForInsert(key: Integer): Integer;
var i,dx,f,
    oldRes,res : Integer;
begin
 i := itemCount shr 1;
 dx := i;
 Result := itemCount;
 if (itemCount > 0) then
 begin
  f := 0;
  res := 2;
  while (true) do
   begin
    dx := dx shr 1;
    if (dx < 1) then dx := 1;
     oldRes := res;
     // compare, ascending
     if (KeyItems[i] = key) then
      res := 0
     else
      if (KeyItems[i] < key) then
       res := 1
      else
       res := -1;
    if (res < 0) then
     begin
      //  element, specified by value should be higher then current element (+->0)
      i := i - dx;
     end
    else
    if (res > 0) then
     begin
      //  element, specified by value should be lower then current element (+->0)
      i := i + dx;
     end
    else // values are equal
     begin
      Result := i;
      break;
     end;
    if  (i < 0) and (dx = 1) then
     begin
      Result := 0;
      break;
     end;
    if  (i > itemCount-1) and (dx = 1) then
     begin
      Result := itemCount;
      break;
     end;

    if  (i > itemCount-1) then
     i := itemCount-1;
    if  i < 0 then
     i := 0;

    if (dx = 1) and (f > 1) then
     begin
      // dx minimum
      // compare, ascending
      if (KeyItems[i] = key) then
       res := 0
      else
       if (KeyItems[i] < key) then
        res := 1
       else
        res := -1;

      if (res < 0) and (oldRes > 0) then
       Result := i;
      if (res > 0) and (oldRes < 0) then
       Result := i+1;
      if (res = oldRes) then
       continue;
      break;
     end;// last step
    if (res <> oldRes) and (dx = 1) and (oldRes <> 2) then
     inc(f);
  end;//while dx
 end; // if itemCount > 0
end;//FindPositionForInsert


//------------------------------------------------------------------------------
// Insert an element into specified position
//------------------------------------------------------------------------------
procedure TABSSortedPageList.Insert(Page: TABSPage);
var
  pos : Integer;
  value: TABSPageElement;
begin
 Inc(LRUCount);
 value.Page := Page;
 value.LRUCount := LRUCount;
 if (itemCount <= 0) then
  InsertByPosition(0,Page.PageNo,value)
 else
  if (itemCount = 1) then
   begin
    if (KeyItems[0] <= Page.PageNo) then
     InsertByPosition(1,Page.PageNo,value)
    else
     InsertByPosition(0,Page.PageNo,value);
   end
  else
   begin
    pos := FindPositionForInsert(Page.PageNo);
    InsertByPosition(pos,Page.PageNo,value);
   end;
end;//Insert


//------------------------------------------------------------------------------
// Insert an element into specified position
//------------------------------------------------------------------------------
procedure TABSSortedPageList.InsertByPosition(ItemNo, key: integer; var value: TABSPageElement);
begin
 inc(ItemCount);
 SetSize(ItemCount);
 if (itemCount <= 1) then
  begin
   KeyItems[0] := key;
   ValueItems[0] := value;
  end
 else
 if (itemNo >= itemCount-1)
  then
   begin
    KeyItems[itemCount-1] := key;
    ValueItems[itemCount-1] := value;
   end
  else
   begin
    Move(KeyItems[itemNo],KeyItems[itemNo+1],
        (itemCount - itemNo-1) * sizeOf(integer));
    Move(ValueItems[itemNo],ValueItems[itemNo+1],
        (itemCount - itemNo-1) * sizeOf(ValueItems[0]));
    KeyItems[itemNo] := key;
    ValueItems[itemNo] := value;
   end;
end;//InsertByPosition


//------------------------------------------------------------------------------
// Set length of array to specified size
//------------------------------------------------------------------------------
procedure TABSSortedPageList.SetSize(newSize: integer);
begin
 if (newSize = 0) then
  begin
   ItemCount := 0;
   allocItemCount := 0;
   KeyItems := nil;
   ValueItems := nil;
   Exit;
  end;

 if (newSize > allocItemCount) then
  begin
     AllocBy := AllocBy * 2;
     if (AllocBy > MaxAllocBy) then
      AllocBy := MaxAllocBy;
     if (allocItemCount + AllocBy > newSize) then
      allocItemCount := allocItemCount + AllocBy
     else
      allocItemCount := newSize;
     SetLength(KeyItems,allocItemCount);
     SetLength(ValueItems,allocItemCount);
  end
 else
  if (newSize < ItemCount) then
   if (allocItemCount-newSize > deAllocBy) then
    begin
     deAllocBy := deAllocBy * 2;
     if (deAllocBy > MaxAllocBy) then
      deAllocBy := MaxAllocBy;
     SetLength(KeyItems,newSize);
     SetLength(ValueItems,newSize);
     allocItemCount := newSize;
    end;

 ItemCount := newSize;
end;//SetSize


////////////////////////////////////////////////////////////////////////////////
//
// TABSPageManager
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// lock
//------------------------------------------------------------------------------
procedure TABSPageManager.Lock;
begin
  EnterCriticalSection(FCSect);
end;// Lock


//------------------------------------------------------------------------------
// unlock
//------------------------------------------------------------------------------
procedure TABSPageManager.Unlock;
begin
  LeaveCriticalSection(FCSect);
end;// Unlock


//------------------------------------------------------------------------------
// AddNewSession
//------------------------------------------------------------------------------
function TABSPageManager.AddNewSession(SessionID: TABSSessionID): Integer;
var
  n: Integer;
begin
  n := Length(FSessions);
  SetLength(FSessions, n+1);

  FSessions[n].SessionID := SessionID;
  FSessions[n].DirtyPages := TABSSortedPageList.Create;
  FSessions[n].AddedPageNumbers := TABSPagesArray.Create;
  FSessions[n].RemovedPageNumbers := TABSPagesArray.Create;
  Result := n;
end;// AddNewSession


//------------------------------------------------------------------------------
// FindSession
//------------------------------------------------------------------------------
function TABSPageManager.FindSession(SessionID: TABSSessionID; var SessionNo: Integer): Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to Length(FSessions)-1 do
    if (FSessions[i].SessionID = SessionID) then
     begin
       Result := True;
       SessionNo := i;
       break;
     end;
end;// FindSession


//------------------------------------------------------------------------------
// FindPage
//------------------------------------------------------------------------------
function TABSPageManager.FindPage(Pages: TABSSortedPageList; PageNo: TABSPageNo; var Page: TABSPage): Boolean;
begin
  Page := nil;
  Result := False;
  if (Pages <> nil) then
    begin
      Page := TABSPage(Pages.Find(PageNo));
      Result := (Page <> nil);
    end;
end;// FindPage


//------------------------------------------------------------------------------
// return page count
//------------------------------------------------------------------------------
function TABSPageManager.GetPageCount: TABSPageNo;
begin
  Result := FPageCount;
end; // GetPageCount


//------------------------------------------------------------------------------
// IsSafeNotToSyncPage
//------------------------------------------------------------------------------
function TABSPageManager.IsSafeNotToSyncPage(SessionID: TABSSessionID; Page: TABSPage): Boolean;
begin
  Result := False;
// override in TABSDiskPageManager
end;// IsSafeNotToSyncPage


//------------------------------------------------------------------------------
// UpdatePageTableState
//------------------------------------------------------------------------------
procedure TABSPageManager.UpdatePageTableState(SessionID: TABSSessionID; Page: TABSPage);
begin
// override in TABSDiskPageManager
end;// UpdatePageTableState


//------------------------------------------------------------------------------
// RemovePageIfExists
//------------------------------------------------------------------------------
procedure TABSPageManager.RemovePageIfExists(Pages: TABSSortedPageList; PageNo: TABSPageNo);
var
  Page: TABSPage;
begin
  if (FindPage(Pages, PageNo, Page)) then
   begin
     Pages.Delete(PageNo);
     Page.Free;
   end;
end;// RemovePageIfExists


//------------------------------------------------------------------------------
// LoadFromStream
//------------------------------------------------------------------------------
procedure TABSPageManager.LoadFromStream(Stream: TStream);
begin
;
end; // LoadFromStream


//------------------------------------------------------------------------------
// SaveToStream
//------------------------------------------------------------------------------
procedure TABSPageManager.SaveToStream(Stream: TStream);
begin
;
end; // SaveToStream


//------------------------------------------------------------------------------
// constructor
//------------------------------------------------------------------------------
constructor TABSPageManager.Create;
begin
  InitializeCriticalSection(FCSect);
  FCacheCapacity := min(1000, (MemoryManager.GetFreeMemorySize div 65536));
  FSharedPages := TABSSortedPageList.Create;
  FMultiUser := False;
  FIgnoreCRCErrors := False;
end;// Create


//------------------------------------------------------------------------------
// destructor
//------------------------------------------------------------------------------
destructor TABSPageManager.Destroy;
var
  i: Integer;
begin
  for i := 0 to Length(FSessions)-1 do
   begin
    if (FSessions[i].DirtyPages.Count > 0) then
      raise EABSException.Create(20097, ErrorAUncommitedPages);
    FSessions[i].DirtyPages.Free;
    FSessions[i].AddedPageNumbers.Free;
    FSessions[i].RemovedPageNumbers.Free;
   end;

  for i := 0 to FSharedPages.Count-1 do
    FSharedPages.ValueItems[i].Page.Free;

  FSharedPages.Free;
  DeleteCriticalSection(FCSect);
end;// Destroy


//------------------------------------------------------------------------------
// AddPage
//------------------------------------------------------------------------------
function TABSPageManager.AddPage(SessionID: TABSSessionID; PageType: TABSPageTypeID): TABSPage;
var
  SessionNo: Integer;
begin
    if (not FindSession(SessionID, SessionNo)) then
      SessionNo := AddNewSession(SessionID);
    Result := TABSPage.Create(Self);
    InternalAddPage(Result);
    if (Result.PageNo = INVALID_PAGE_NO) then
      raise EABSException.Create(20064, ErrorAInvalidPageNo);
    Result.UseCount := Result.UseCount + 1;
    Result.IsDirty := True;
    Result.Reloaded := False;
    if (Result.PageHeaderSize > 0) then
      begin
        Result.PageHeader^.PageType := PageType;
        Result.PageHeader^.State := Random(MaxInt div 2);
      end;
    Result.ParentList := FSessions[SessionNo].DirtyPages;
    Result.SessionID := SessionID;
{$IFDEF FILE_SERVER_VERSION}    
    // check for delete of page by another user
    if (FSharedPages.Find(Result.PageNo) <> nil) then
      FSharedPages.Delete(Result.PageNo);
{$ENDIF}
    FSessions[SessionNo].DirtyPages.Insert(Result);
    FSessions[SessionNo].AddedPageNumbers.Append(Result.PageNo);
end;// AddPage


//------------------------------------------------------------------------------
// RemovePage
//------------------------------------------------------------------------------
procedure TABSPageManager.RemovePage(SessionID: TABSSessionID; PageNo: TABSPageNo);
var
  SessionNo: Integer;
begin
    if (not FindSession(SessionID, SessionNo)) then
      SessionNo := AddNewSession(SessionID);
    FSessions[SessionNo].RemovedPageNumbers.Append(PageNo);
end;// RemovePage


//------------------------------------------------------------------------------
// GetPage
//------------------------------------------------------------------------------
function TABSPageManager.GetPage(SessionID: TABSSessionID; PageNo: TABSPageNo;
         PageType: TABSPageTypeID; SynchronizeAllowed: Boolean = True): TABSPage;
var
  SessionNo: Integer;
begin
    if (SessionID = INVALID_SESSION_ID) then
      raise EABSException.Create(20186, ErrorAInvalidSessionID);
    if (not FindSession(SessionID, SessionNo)) then
      SessionNo := AddNewSession(SessionID);
    if (not (FindPage(FSessions[SessionNo].DirtyPages, PageNo, Result))) then
     begin
      if (FindPage(FSharedPages, PageNo, Result)) then
        begin
          if (SynchronizeAllowed and
              not IsSafeNotToSyncPage(SessionID, Result)) then
            begin
              Result.Synchronize;
              UpdatePageTableState(SessionID, Result);
            end;
        end
      else
       begin
        Result := TABSPage.Create(Self);
        Result.PageNo := PageNo;
        Result.SessionID := SessionID;
        FSharedPages.Insert(Result);
        if (not InternalReadPage(Result)) then
          raise EABSException.Create(20299, ErrorAErrorReadingPage, [PageNo, PageType]);

        if (not IgnoreCRCErrors) and ((Result.PageHeaderSize > 0) and (PageType <> ptAnyPage) and
            (Result.PageHeader^.PageType <> PageType)) then
          raise EABSException.Create(20153, ErrorAInvalidPageType, [PageType, Result.PageHeader^.PageType]);
        UpdatePageTableState(SessionID, Result);
       end;
      Result.ParentList := FSharedPages;
     end;

    if ((Result.UseCount > 0) and (Result.SessionID <> SessionID)) then
      raise EABSException.Create(20090, ErrorAPageIsUsedByOtherSession);
    Result.SessionID := SessionID;
    Result.UseCount := TABSPage(Result).UseCount + 1;
end;// GetPage


//------------------------------------------------------------------------------
// PutPage
//------------------------------------------------------------------------------
procedure TABSPageManager.PutPage(aPage: TABSPage);
var
  SessionNo: Integer;
  PageToRelease: TABSPage;
begin
{$IFDEF DEBUG_PAGES}
  if (aPage.PageNo = INVALID_PAGE_NO) then
    raise EABSException.Create(20065, ErrorAInvalidPageNo);
  if ((aPage.PageHeaderSize > 0) and
      (aPage.PageHeader^.PageType > ptLastType)) then
    raise EABSException.Create(20154, ErrorAInvalidPage);
  if (aPage.UseCount < 1) then
    raise EABSException.Create(20163, ErrorAInvalidPageUseCount);
  if (aPage.ParentList.Find(aPage.PageNo) = nil) then
    raise EABSException.Create(20040, ErrorAUsedPageWasReleased);
{$ENDIF}
      aPage.UseCount := aPage.UseCount - 1;
      if (aPage.UseCount = 0) then
        aPage.Reloaded := False;
      // apply LRU cache (last items are more recently used) and dirty page move
      if ((aPage.UseCount = 0) and (aPage.ParentList = FSharedPages)) then
       begin
        if (aPage.IsDirty) then
         begin
           FSharedPages.Delete(aPage.PageNo);
           if (not FindSession(aPage.SessionID, SessionNo)) then
             SessionNo := AddNewSession(aPage.SessionID);
           FSessions[SessionNo].DirtyPages.Insert(aPage);
           aPage.ParentList := FSessions[SessionNo].DirtyPages;
         end
        else
          FSharedPages.UpdateLRU(aPage);
       end;
      if (aPage.ParentList = FSharedPages) then
        // if cache overflow remove first unused pages
        if (FSharedPages.Count > FCacheCapacity) then
         begin
           PageToRelease := FSharedPages.FirstByLRU;
           while (PageToRelease <> nil) do
             begin
              if (PageToRelease.UseCount = 0) then
               begin
                 FSharedPages.Delete(PageToRelease.PageNo);
                 PageToRelease.Free;
                 if (FSharedPages.Count <= FCacheCapacity) then
                  break;
               end;
              PageToRelease := FSharedPages.NextByLRU;
             end;
         end;

end;// PutPage


//------------------------------------------------------------------------------
// ApplyChanges
//------------------------------------------------------------------------------
procedure TABSPageManager.ApplyChanges(SessionID: TABSSessionID);
var
  SessionNo: Integer;
  i:       Integer;
  Page:      TABSPage;
begin
    for i:=0 to FSharedPages.Count-1 do
     begin
       Page := FSharedPages.ValueItems[i].Page;
       if ((Page.SessionID = SessionID) and (Page.UseCount > 0)) then
        raise EABSException.Create(20152, ErrorASomePagesAreNotReleased);
     end;

    if (FindSession(SessionID, SessionNo)) then
      begin
        // free removed pages
        for i := 0 to FSessions[SessionNo].RemovedPageNumbers.ItemCount-1 do
         begin
           InternalRemovePage(FSessions[SessionNo].RemovedPageNumbers.Items[i]);
           RemovePageIfExists(FSessions[SessionNo].DirtyPages,
                       FSessions[SessionNo].RemovedPageNumbers.Items[i]);
           RemovePageIfExists(FSharedPages,
                       FSessions[SessionNo].RemovedPageNumbers.Items[i]);
         end;
        FSessions[SessionNo].RemovedPageNumbers.SetSize(0);
        FSessions[SessionNo].AddedPageNumbers.SetSize(0);

        // save dirty pages
        for i := 0 to FSessions[SessionNo].DirtyPages.Count-1 do
         begin
           Page := FSessions[SessionNo].DirtyPages.ValueItems[i].Page;
           if (not Page.IsDirty) then
             raise EABSException.Create(20085, ErrorAInvalidDirtyPage);
           if (Page.UseCount > 0) then
             raise EABSException.Create(20086, ErrorACannotWriteUsedPage);
           InternalWritePage(Page);
           Page.IsDirty := False;
           // move dirty page to shared pages list
           if (FSharedPages.Count < FCacheCapacity) then
             FSharedPages.Insert(Page)
           else
             Page.Free;
         end;
        FSessions[SessionNo].DirtyPages.Clear;
      end;
end;// ApplyChanges


//------------------------------------------------------------------------------
// CancelChanges
//------------------------------------------------------------------------------
procedure TABSPageManager.CancelChanges(SessionID: TABSSessionID);
var
  SessionNo: Integer;
  i:         Integer;
  Page:      TABSPage;
begin
    if (FindSession(SessionID, SessionNo)) then
      begin
        // free dirty pages
        for i := 0 to FSessions[SessionNo].DirtyPages.Count-1 do
         begin
           Page := FSessions[SessionNo].DirtyPages.ValueItems[i].Page;
           if (not Page.IsDirty) then
             raise EABSException.Create(20087, ErrorAInvalidIndexPage);
           if (Page.UseCount > 0) then
             raise EABSException.Create(20088, ErrorACannotRemoveUsedPage);
           Page.Free;
         end;
        FSessions[SessionNo].DirtyPages.Clear;

        // free added pages
        for i := 0 to FSessions[SessionNo].AddedPageNumbers.ItemCount-1 do
          InternalRemovePage(FSessions[SessionNo].AddedPageNumbers.Items[i]);

        FSessions[SessionNo].RemovedPageNumbers.SetSize(0);
        FSessions[SessionNo].AddedPageNumbers.SetSize(0);
      end;
end;// CancelChanges


end.
