ezdslcol.pas

Eazy Data Structures library for Delphi.

{===EZDSLCOL==========================================================

Part of the EZ Delphi Structures Library--the collection classes.

EZDSLCOL is Copyright (c) 1993-2002 by  Julian M. Bucknall

VERSION HISTORY
12Feb02 JMB 3.03 Release for Delphi 6
24Oct99 JMB 3.02 Release for Delphi 4 & 5
19Apr98 JMB 3.00 Major new version, release for Delphi 3
24May96 JMB 2.01 Clone & Assign always duped data objects
13Mar96 JMB 2.00 release for Delphi 2.0
18Jun95 JMB 1.00 initial release
=====================================================================}
{ Copyright (c) 1993-2002, Julian M. Bucknall. All Rights Reserved   }
                         
unit EzdslCol;

{$I EzdslDef.inc}
{---Place any compiler options you require here----------------------}


{--------------------------------------------------------------------}
{$I EzdslOpt.inc}

interface

uses
  SysUtils,
  {$IFDEF Windows}
  WinTypes,
  WinProcs,
  {$ENDIF}
  {$IFDEF Win32}
  Windows,
  {$ENDIF}
  {$IFDEF Linux}
  Types,
  Libc,
  {$ENDIF}
  Classes,
  EzdslCts,
  EzdslSup,
  EzdslBse;

const
  ezcPageElementCount = 92;
  ezcPageArrayElementCount = 10922;
  ezcMaxCount = ezcPageElementCount * ezcPageArrayElementCount;

  coIndexError = -1;
  coOverflow   = -2;

type
  PezcPage = ^TezcPage;
  TezcPage = array [0..pred(ezcPageElementCount)] of pointer;

  PezcPageItem = ^TezcPageItem;
  TezcPageItem = record
    piUsedItems : integer;
    piItems     : PezcPage;
  end;

  PezcPageArray = ^TezcPageArray;
  TezcPageArray = array [0..pred(ezcPageArrayElementCount)] of TezcPageItem;

  TEZCollection = class(TAbstractContainer)
    private
      coPA : PezcPageArray;
      coSizeOfPA : Cardinal;
      coItemsInPA : integer;
      coMaxItemsInPA : integer;

      coCacheIndex     : longint;
      coCachePageNum   : integer;
      coCacheInxInPage : integer;

    protected
      function GetLimit : longint;

      procedure AddPageItem(AtIndex : integer);
      procedure DeletePageItem(AtIndex : integer);
      function GetPageGivenIndex(Index : longint;
                                  var InxInPage : integer) : integer;
      procedure GrowPageArray(NewNumElements : integer);
      procedure ValidateIndex(Index : longint);

    public
      constructor Create(DataOwner : boolean); override;
      constructor Clone(Source : TAbstractContainer;
                        DataOwner : boolean; NewCompare : TCompareFunc); override;
      destructor Destroy; override;

      procedure Assign(Source : TPersistent); override;

      procedure Empty; override;

      function At(Index : longint) : pointer;
      procedure AtDelete(Index : longint);
      procedure AtFree(Index : longint);
      procedure AtInsert(Index : longint; Item : pointer);
      procedure AtPut(Index : longint; Item : pointer);
      procedure Delete(Item : pointer);
      procedure DeleteAll;
      procedure Free(Item : pointer);
      procedure FreeAll;
      function IndexOf(Item : pointer) : longint; virtual;
      procedure Insert(Item : pointer); virtual;
      function Iterate(Action : TIterator; Backwards : boolean;
                        ExtraData : pointer) : pointer;
      procedure Pack;

      property Limit : longint
         read GetLimit;

      property Items[Index : longint] : pointer
         read At
         write AtPut;
         default;
  end;

  TEZSortedCollection = class(TEZCollection)
    public
      constructor Create(DataOwner : boolean); override;

      function IndexOf(Item : pointer) : longint; override;
      procedure Insert(Item : pointer); override;
      function Search(Item : pointer; var Index : longint) : boolean; virtual;
  end;

  TEZStringCollection = class(TEZSortedCollection)
    public
      constructor Create(DataOwner : boolean); override;
  end;

  TEZStrZCollection = class(TEZSortedCollection)
    protected
    public
      constructor Create(DataOwner : boolean); override;
  end;

implementation

procedure RaiseCollError(Code : integer);
var
  SCode : integer;
begin
  case Code of
    coIndexError : SCode := escIndexError;
    coOverflow   : SCode := escTooManyItems;
  else
    SCode := escBadCaseSwitch;
  end;
  EZDSLSup.RaiseError(SCode);
end;

{===TEZCollection creation/destruction===============================}
constructor TEZCollection.Create(DataOwner : boolean);
begin
  acNodeSize := 0;
  inherited Create(DataOwner);

  GrowPageArray(1);
  AddPageItem(0);
end;
{--------}
constructor TEZCollection.Clone(Source : TAbstractContainer;
                                DataOwner : boolean; NewCompare : TCompareFunc);
var
  OldColl : TEZCollection absolute Source;
  NewData : pointer;
  i       : longint;
begin
  Create(DataOwner);
  Compare := NewCompare;
  DupData := OldColl.DupData;
  DisposeData := OldColl.DisposeData;

  if not (Source is TEZCollection) then
    RaiseError(escBadSource);

  if not OldColl.IsEmpty then begin
    for i := 0 to pred(OldColl.Count) do begin
      if DataOwner then
        NewData := DupData(OldColl.Items[i])
      else
        NewData := OldColl.Items[i];
      try
        Insert(NewData);
      except
        if DataOwner and Assigned(NewData) then
          DisposeData(NewData);
        raise;
      end;{try..except}
    end;
  end;
end;
{--------}
destructor TEZCollection.Destroy;
begin
  inherited Destroy;
  if Assigned(coPA) then begin
    DeletePageItem(0);
    FreeMem(coPA, coSizeOfPA);
  end;
end;
{====================================================================}


{===TEZCollection helper methods=====================================}
procedure TEZCollection.AddPageItem(AtIndex : integer);
var
  NewPage : PezcPage;
  NewMax  : integer;
begin
  {$IFDEF DEBUG}
  if (AtIndex > coItemsInPA) then
    raise Exception.Create('Bad AtIndex parm to AddPageItem');
  {$ENDIF}
  if (coItemsInPA = coMaxItemsInPA) then begin
    if (coMaxItemsInPA < ezcPageArrayElementCount) then begin
      case coMaxItemsInPA of
        1 : NewMax := 2;
        2 : NewMax := 4;
        4 : NewMax := 8;
        8 : NewMax := 16;
      else
        NewMax := coMaxItemsInPA + 16;
        if (NewMax > ezcPageArrayElementCount) then
          NewMax := ezcPageArrayElementCount;
      end;{case}
      GrowPageArray(NewMax);
    end
    else begin
      Pack;
      if (coItemsInPA = ezcPageArrayElementCount) then
        RaiseCollError(coOverflow);
    end;
  end;
  SafeGetMem(NewPage, ezcPageElementCount * sizeof(pointer));
  if (AtIndex < coItemsInPA) then
    Move(coPA^[AtIndex], coPA^[succ(AtIndex)], (coItemsInPA - AtIndex) * sizeof(TezcPageItem));
  with coPA^[AtIndex] do begin
    piUsedItems := 0;
    piItems := NewPage;
  end;
  inc(coItemsInPA);
end;
{--------}
procedure TEZCollection.DeletePageItem(AtIndex : integer);
begin
  {$IFDEF DEBUG}
  if (AtIndex >= coItemsInPA) then
    raise Exception.Create('Bad AtIndex parm to DeletePageItem');
  {$ENDIF}
  with coPA^[AtIndex] do
    FreeMem(piItems, ezcPageElementCount * sizeof(pointer));
  dec(coItemsInPA);
  if (AtIndex < coItemsInPA) then
    Move(coPA^[succ(AtIndex)], coPA^[AtIndex], (coItemsInPA - AtIndex) * sizeof(TezcPageItem));
end;
{--------}
function TEZCollection.GetPageGivenIndex(Index : longint;
                                          var InxInPage : integer) : integer;
const
  SizeOfPageItem = sizeof(TezcPageItem);
var
  PageNum    : integer;
  StartIndex : longint;
  GoForward  : boolean;
begin
  if (Index = coCacheIndex) then begin
    Result := coCachePageNum;
    InxInPage := coCacheInxInPage;
    Exit;
  end;
  if (Index < coCacheIndex) then begin
    if ((Index * 2) <= coCacheIndex) then begin
      {Index is closer to 0 than coCacheIndex}
      PageNum := 0;
      StartIndex := Index;
      GoForward := true;
    end
    else begin
      {Index is closer to coCacheIndex than 0}
      PageNum := coCachePageNum;
      StartIndex :=
         (coCacheIndex - coCacheInxInPage + coPA^[coCachePageNum].piUsedItems) -
         Index;
      GoForward := false;
    end;
  end
  else {Index > coCacheIndex} begin
    if (Index - coCacheIndex) <= (Count - Index - 1) then begin
      {Index is closer to coCacheIndex than Count}
      PageNum := coCachePageNum;
      StartIndex := Index - (coCacheIndex - coCacheInxInPage);
      GoForward := true;
    end
    else begin
      {Index is closer to Count than coCacheIndex}
      PageNum := pred(coItemsInPA);
      StartIndex := Count - Index;
      GoForward := false;
    end;
  end;
  {$IFDEF BASM32}
  if GoForward then
    asm
      mov edx, Self
      mov edx, [edx].TEZCollection.coPA

      mov ecx, PageNum      {This assumes sizeof(TezcPageItem)=8}
      mov eax, ecx
      shl eax, 3
      add edx, eax

      mov eax, StartIndex
    @@NextPage:
      sub eax, [edx].TezcPageItem.piUsedItems
      jl @@FoundIt
      inc ecx
      add edx, SizeOfPageItem
      jmp @@NextPage
    @@FoundIt:
      add eax, [edx].TezcPageItem.piUsedItems
      mov edx, InxInPage
      mov [edx], eax
      mov @Result, ecx
    end
  else {go backwards}
    asm
      mov edx, Self
      mov edx, [edx].TEZCollection.coPA

      mov ecx, PageNum      {This assumes sizeof(TezcPageItem)=8}
      mov eax, ecx
      shl eax, 3
      add edx, eax

      mov eax, StartIndex
    @@NextPage:
      sub eax, [edx].TezcPageItem.piUsedItems
      jl @@FoundIt
      je @@FoundItAsZero
      dec ecx
      sub edx, SizeOfPageItem
      jmp @@NextPage
    @@FoundIt:
      neg eax
    @@FoundItAsZero:
      mov edx, InxInPage
      mov [edx], eax
      mov @Result, ecx
    end;
  {$ELSE}
  if GoForward then
    asm
      mov si, ds           {SI stores the Delphi data segment}
      lds di, Self
      lds di, [di].TEZCollection.coPA

      mov cx, PageNum      {This assumes sizeof(TezcPageItem)=6}
      mov ax, cx
      shl ax, 1
      add ax, cx
      shl ax, 1
      add di, ax

      xor bx, bx
      mov dx, StartIndex.Word[2]
      mov ax, StartIndex.Word[0]
    @@NextPage:
      sub ax, [di].TezcPageItem.piUsedItems
      sbb dx, bx
      jl @@FoundIt
      inc cx
      add di, SizeOfPageItem
      jmp @@NextPage
    @@FoundIt:
      add ax, [di].TezcPageItem.piUsedItems
      lds di, InxInPage
      mov [di], ax
      mov ds, si
      mov @Result, cx
    end
  else
    asm
      push ds
      lds di, Self
      lds di, [di].TEZCollection.coPA

      mov cx, PageNum      {This assumes sizeof(TezcPageItem)=6}
      mov ax, cx
      shl ax, 1
      add ax, cx
      shl ax, 1
      add di, ax

      xor bx, bx
      mov dx, StartIndex.Word[2]
      mov ax, StartIndex.Word[0]
    @@NextPage:
      sub ax, [di].TezcPageItem.piUsedItems
      sbb dx, bx
      jl @@FoundIt
      mov si, ax
      or si, dx
      je @@FoundItAsZero
      dec cx
      sub di, SizeOfPageItem
      jmp @@NextPage
    @@FoundIt:
      neg ax
    @@FoundItAsZero:
      lds di, InxInPage
      mov [di], ax
      pop ds
      mov @Result, cx
    end;
  {$ENDIF}
  coCacheIndex := Index;
  coCachePageNum := Result;
  coCacheInxInPage := InxInPage;
end;
{--------}
procedure TEZCollection.GrowPageArray(NewNumElements : integer);
var
  NewSize : Cardinal;