unit uutlArrayContainer; {$mode objfpc}{$H+} interface uses Classes, SysUtils, uutlCommon; type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlArrayContainer = class(TutlInterfaceNoRefCount) protected type PT = ^T; strict private fList: PT; fCapacity: Integer; fOwnsItems: Boolean; fCanShrink: Boolean; fCanExpand: Boolean; function GetIsEmpty: Boolean; inline; protected function GetCount: Integer; virtual; abstract; procedure SetCount (const aValue: Integer); virtual; abstract; function GetInternalItem (const aIndex: Integer): PT; procedure SetCapacity (const aValue: integer); virtual; procedure Release (var aItem: T; const aFreeItem: Boolean); virtual; procedure Shrink (const aExactFit: Boolean); procedure Expand; protected property Count: Integer read GetCount write SetCount; property IsEmpty: Boolean read GetIsEmpty; property Capacity: Integer read fCapacity write SetCapacity; property CanShrink: Boolean read fCanShrink write fCanShrink; property CanExpand: Boolean read fCanExpand write fCanExpand; property OwnsItems: Boolean read fOwnsItems write fOwnsItems; public constructor Create(const aOwnsItems: Boolean); destructor Destroy; override; end; implementation //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlArrayContainer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlArrayContainer.GetIsEmpty: Boolean; begin result := (Count = 0); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlArrayContainer.GetInternalItem(const aIndex: Integer): PT; begin if (aIndex < 0) or (aIndex >= fCapacity) then raise EOutOfRangeException.Create('capacity out of range', aIndex, 0, fCapacity-1); result := fList + aIndex; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlArrayContainer.SetCapacity(const aValue: integer); begin if (fCapacity = aValue) then exit; if (aValue < Count) then raise EArgumentException.Create('can not reduce capacity below count'); ReAllocMem(fList, aValue * SizeOf(T)); FillByte((fList + fCapacity)^, (aValue - fCapacity) * SizeOf(T), 0); fCapacity := aValue; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlArrayContainer.Release(var aItem: T; const aFreeItem: Boolean); begin if not utlFinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem) then Finalize(aItem); FillByte(aItem, SizeOf(aItem), 0); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlArrayContainer.Shrink(const aExactFit: Boolean); begin if not fCanShrink then raise EInvalidOperation.Create('shrinking is not allowed'); if (aExactFit) then SetCapacity(Count) else if (fCapacity > 128) and (Count < fCapacity shr 2) then // less than 25% used SetCapacity(fCapacity shr 1); // shrink to 50% end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlArrayContainer.Expand; begin if (Count < fCapacity) then exit; if not fCanExpand then raise EInvalidOperation.Create('expanding is not allowed'); if (fCapacity <= 0) then SetCapacity(4) else if (fCapacity < 128) then SetCapacity(fCapacity shl 1) // + 100% else SetCapacity(fCapacity + fCapacity shr 2); // + 25% end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlArrayContainer.Create(const aOwnsItems: Boolean); begin inherited Create; fOwnsItems := aOwnsItems; fList := nil; fCapacity := 0; fCanExpand := true; fCanShrink := true; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TutlArrayContainer.Destroy; begin if Assigned(fList) then begin FreeMem(fList); fList := nil; end; inherited Destroy; end; end.